module Stratosphere.AppMesh.VirtualNode.ListenerProperty (
        module Exports, ListenerProperty(..), mkListenerProperty
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.AppMesh.VirtualNode.HealthCheckProperty as Exports
import {-# SOURCE #-} Stratosphere.AppMesh.VirtualNode.ListenerTimeoutProperty as Exports
import {-# SOURCE #-} Stratosphere.AppMesh.VirtualNode.ListenerTlsProperty as Exports
import {-# SOURCE #-} Stratosphere.AppMesh.VirtualNode.OutlierDetectionProperty as Exports
import {-# SOURCE #-} Stratosphere.AppMesh.VirtualNode.PortMappingProperty as Exports
import {-# SOURCE #-} Stratosphere.AppMesh.VirtualNode.VirtualNodeConnectionPoolProperty as Exports
import Stratosphere.ResourceProperties
data ListenerProperty
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-virtualnode-listener.html>
    ListenerProperty {ListenerProperty -> ()
haddock_workaround_ :: (),
                      -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-virtualnode-listener.html#cfn-appmesh-virtualnode-listener-connectionpool>
                      ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
connectionPool :: (Prelude.Maybe VirtualNodeConnectionPoolProperty),
                      -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-virtualnode-listener.html#cfn-appmesh-virtualnode-listener-healthcheck>
                      ListenerProperty -> Maybe HealthCheckProperty
healthCheck :: (Prelude.Maybe HealthCheckProperty),
                      -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-virtualnode-listener.html#cfn-appmesh-virtualnode-listener-outlierdetection>
                      ListenerProperty -> Maybe OutlierDetectionProperty
outlierDetection :: (Prelude.Maybe OutlierDetectionProperty),
                      -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-virtualnode-listener.html#cfn-appmesh-virtualnode-listener-portmapping>
                      ListenerProperty -> PortMappingProperty
portMapping :: PortMappingProperty,
                      -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-virtualnode-listener.html#cfn-appmesh-virtualnode-listener-tls>
                      ListenerProperty -> Maybe ListenerTlsProperty
tLS :: (Prelude.Maybe ListenerTlsProperty),
                      -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-properties-appmesh-virtualnode-listener.html#cfn-appmesh-virtualnode-listener-timeout>
                      ListenerProperty -> Maybe ListenerTimeoutProperty
timeout :: (Prelude.Maybe ListenerTimeoutProperty)}
  deriving stock (ListenerProperty -> ListenerProperty -> Bool
(ListenerProperty -> ListenerProperty -> Bool)
-> (ListenerProperty -> ListenerProperty -> Bool)
-> Eq ListenerProperty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ListenerProperty -> ListenerProperty -> Bool
== :: ListenerProperty -> ListenerProperty -> Bool
$c/= :: ListenerProperty -> ListenerProperty -> Bool
/= :: ListenerProperty -> ListenerProperty -> Bool
Prelude.Eq, Int -> ListenerProperty -> ShowS
[ListenerProperty] -> ShowS
ListenerProperty -> String
(Int -> ListenerProperty -> ShowS)
-> (ListenerProperty -> String)
-> ([ListenerProperty] -> ShowS)
-> Show ListenerProperty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ListenerProperty -> ShowS
showsPrec :: Int -> ListenerProperty -> ShowS
$cshow :: ListenerProperty -> String
show :: ListenerProperty -> String
$cshowList :: [ListenerProperty] -> ShowS
showList :: [ListenerProperty] -> ShowS
Prelude.Show)
mkListenerProperty :: PortMappingProperty -> ListenerProperty
mkListenerProperty :: PortMappingProperty -> ListenerProperty
mkListenerProperty PortMappingProperty
portMapping
  = ListenerProperty
      {haddock_workaround_ :: ()
haddock_workaround_ = (), portMapping :: PortMappingProperty
portMapping = PortMappingProperty
portMapping,
       connectionPool :: Maybe VirtualNodeConnectionPoolProperty
connectionPool = Maybe VirtualNodeConnectionPoolProperty
forall a. Maybe a
Prelude.Nothing, healthCheck :: Maybe HealthCheckProperty
healthCheck = Maybe HealthCheckProperty
forall a. Maybe a
Prelude.Nothing,
       outlierDetection :: Maybe OutlierDetectionProperty
outlierDetection = Maybe OutlierDetectionProperty
forall a. Maybe a
Prelude.Nothing, tLS :: Maybe ListenerTlsProperty
tLS = Maybe ListenerTlsProperty
forall a. Maybe a
Prelude.Nothing,
       timeout :: Maybe ListenerTimeoutProperty
timeout = Maybe ListenerTimeoutProperty
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties ListenerProperty where
  toResourceProperties :: ListenerProperty -> ResourceProperties
toResourceProperties ListenerProperty {Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ListenerProperty -> ()
connectionPool :: ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
healthCheck :: ListenerProperty -> Maybe HealthCheckProperty
outlierDetection :: ListenerProperty -> Maybe OutlierDetectionProperty
portMapping :: ListenerProperty -> PortMappingProperty
tLS :: ListenerProperty -> Maybe ListenerTlsProperty
timeout :: ListenerProperty -> Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::AppMesh::VirtualNode.Listener",
         supportsTags :: Bool
supportsTags = Bool
Prelude.False,
         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
"PortMapping" Key -> PortMappingProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= PortMappingProperty
portMapping]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> VirtualNodeConnectionPoolProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ConnectionPool" (VirtualNodeConnectionPoolProperty -> (Key, Value))
-> Maybe VirtualNodeConnectionPoolProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe VirtualNodeConnectionPoolProperty
connectionPool,
                               Key -> HealthCheckProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"HealthCheck" (HealthCheckProperty -> (Key, Value))
-> Maybe HealthCheckProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe HealthCheckProperty
healthCheck,
                               Key -> OutlierDetectionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"OutlierDetection" (OutlierDetectionProperty -> (Key, Value))
-> Maybe OutlierDetectionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe OutlierDetectionProperty
outlierDetection,
                               Key -> ListenerTlsProperty -> (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" (ListenerTlsProperty -> (Key, Value))
-> Maybe ListenerTlsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ListenerTlsProperty
tLS,
                               Key -> ListenerTimeoutProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Timeout" (ListenerTimeoutProperty -> (Key, Value))
-> Maybe ListenerTimeoutProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ListenerTimeoutProperty
timeout]))}
instance JSON.ToJSON ListenerProperty where
  toJSON :: ListenerProperty -> Value
toJSON ListenerProperty {Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ListenerProperty -> ()
connectionPool :: ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
healthCheck :: ListenerProperty -> Maybe HealthCheckProperty
outlierDetection :: ListenerProperty -> Maybe OutlierDetectionProperty
portMapping :: ListenerProperty -> PortMappingProperty
tLS :: ListenerProperty -> Maybe ListenerTlsProperty
timeout :: ListenerProperty -> Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
    = [(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
"PortMapping" Key -> PortMappingProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= PortMappingProperty
portMapping]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> VirtualNodeConnectionPoolProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ConnectionPool" (VirtualNodeConnectionPoolProperty -> (Key, Value))
-> Maybe VirtualNodeConnectionPoolProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe VirtualNodeConnectionPoolProperty
connectionPool,
                  Key -> HealthCheckProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"HealthCheck" (HealthCheckProperty -> (Key, Value))
-> Maybe HealthCheckProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe HealthCheckProperty
healthCheck,
                  Key -> OutlierDetectionProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"OutlierDetection" (OutlierDetectionProperty -> (Key, Value))
-> Maybe OutlierDetectionProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe OutlierDetectionProperty
outlierDetection,
                  Key -> ListenerTlsProperty -> (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" (ListenerTlsProperty -> (Key, Value))
-> Maybe ListenerTlsProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ListenerTlsProperty
tLS,
                  Key -> ListenerTimeoutProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Timeout" (ListenerTimeoutProperty -> (Key, Value))
-> Maybe ListenerTimeoutProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ListenerTimeoutProperty
timeout])))
instance Property "ConnectionPool" ListenerProperty where
  type PropertyType "ConnectionPool" ListenerProperty = VirtualNodeConnectionPoolProperty
  set :: PropertyType "ConnectionPool" ListenerProperty
-> ListenerProperty -> ListenerProperty
set PropertyType "ConnectionPool" ListenerProperty
newValue ListenerProperty {Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ListenerProperty -> ()
connectionPool :: ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
healthCheck :: ListenerProperty -> Maybe HealthCheckProperty
outlierDetection :: ListenerProperty -> Maybe OutlierDetectionProperty
portMapping :: ListenerProperty -> PortMappingProperty
tLS :: ListenerProperty -> Maybe ListenerTlsProperty
timeout :: ListenerProperty -> Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
    = ListenerProperty {connectionPool :: Maybe VirtualNodeConnectionPoolProperty
connectionPool = VirtualNodeConnectionPoolProperty
-> Maybe VirtualNodeConnectionPoolProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ConnectionPool" ListenerProperty
VirtualNodeConnectionPoolProperty
newValue, Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
()
PortMappingProperty
haddock_workaround_ :: ()
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
instance Property "HealthCheck" ListenerProperty where
  type PropertyType "HealthCheck" ListenerProperty = HealthCheckProperty
  set :: PropertyType "HealthCheck" ListenerProperty
-> ListenerProperty -> ListenerProperty
set PropertyType "HealthCheck" ListenerProperty
newValue ListenerProperty {Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ListenerProperty -> ()
connectionPool :: ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
healthCheck :: ListenerProperty -> Maybe HealthCheckProperty
outlierDetection :: ListenerProperty -> Maybe OutlierDetectionProperty
portMapping :: ListenerProperty -> PortMappingProperty
tLS :: ListenerProperty -> Maybe ListenerTlsProperty
timeout :: ListenerProperty -> Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
    = ListenerProperty {healthCheck :: Maybe HealthCheckProperty
healthCheck = HealthCheckProperty -> Maybe HealthCheckProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "HealthCheck" ListenerProperty
HealthCheckProperty
newValue, Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
instance Property "OutlierDetection" ListenerProperty where
  type PropertyType "OutlierDetection" ListenerProperty = OutlierDetectionProperty
  set :: PropertyType "OutlierDetection" ListenerProperty
-> ListenerProperty -> ListenerProperty
set PropertyType "OutlierDetection" ListenerProperty
newValue ListenerProperty {Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ListenerProperty -> ()
connectionPool :: ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
healthCheck :: ListenerProperty -> Maybe HealthCheckProperty
outlierDetection :: ListenerProperty -> Maybe OutlierDetectionProperty
portMapping :: ListenerProperty -> PortMappingProperty
tLS :: ListenerProperty -> Maybe ListenerTlsProperty
timeout :: ListenerProperty -> Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
    = ListenerProperty {outlierDetection :: Maybe OutlierDetectionProperty
outlierDetection = OutlierDetectionProperty -> Maybe OutlierDetectionProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "OutlierDetection" ListenerProperty
OutlierDetectionProperty
newValue, Maybe HealthCheckProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
instance Property "PortMapping" ListenerProperty where
  type PropertyType "PortMapping" ListenerProperty = PortMappingProperty
  set :: PropertyType "PortMapping" ListenerProperty
-> ListenerProperty -> ListenerProperty
set PropertyType "PortMapping" ListenerProperty
newValue ListenerProperty {Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ListenerProperty -> ()
connectionPool :: ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
healthCheck :: ListenerProperty -> Maybe HealthCheckProperty
outlierDetection :: ListenerProperty -> Maybe OutlierDetectionProperty
portMapping :: ListenerProperty -> PortMappingProperty
tLS :: ListenerProperty -> Maybe ListenerTlsProperty
timeout :: ListenerProperty -> Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
    = ListenerProperty {portMapping :: PortMappingProperty
portMapping = PropertyType "PortMapping" ListenerProperty
PortMappingProperty
newValue, Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
instance Property "TLS" ListenerProperty where
  type PropertyType "TLS" ListenerProperty = ListenerTlsProperty
  set :: PropertyType "TLS" ListenerProperty
-> ListenerProperty -> ListenerProperty
set PropertyType "TLS" ListenerProperty
newValue ListenerProperty {Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ListenerProperty -> ()
connectionPool :: ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
healthCheck :: ListenerProperty -> Maybe HealthCheckProperty
outlierDetection :: ListenerProperty -> Maybe OutlierDetectionProperty
portMapping :: ListenerProperty -> PortMappingProperty
tLS :: ListenerProperty -> Maybe ListenerTlsProperty
timeout :: ListenerProperty -> Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
    = ListenerProperty {tLS :: Maybe ListenerTlsProperty
tLS = ListenerTlsProperty -> Maybe ListenerTlsProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "TLS" ListenerProperty
ListenerTlsProperty
newValue, Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
timeout :: Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
timeout :: Maybe ListenerTimeoutProperty
..}
instance Property "Timeout" ListenerProperty where
  type PropertyType "Timeout" ListenerProperty = ListenerTimeoutProperty
  set :: PropertyType "Timeout" ListenerProperty
-> ListenerProperty -> ListenerProperty
set PropertyType "Timeout" ListenerProperty
newValue ListenerProperty {Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTimeoutProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ListenerProperty -> ()
connectionPool :: ListenerProperty -> Maybe VirtualNodeConnectionPoolProperty
healthCheck :: ListenerProperty -> Maybe HealthCheckProperty
outlierDetection :: ListenerProperty -> Maybe OutlierDetectionProperty
portMapping :: ListenerProperty -> PortMappingProperty
tLS :: ListenerProperty -> Maybe ListenerTlsProperty
timeout :: ListenerProperty -> Maybe ListenerTimeoutProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
timeout :: Maybe ListenerTimeoutProperty
..}
    = ListenerProperty {timeout :: Maybe ListenerTimeoutProperty
timeout = ListenerTimeoutProperty -> Maybe ListenerTimeoutProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "Timeout" ListenerProperty
ListenerTimeoutProperty
newValue, Maybe HealthCheckProperty
Maybe OutlierDetectionProperty
Maybe ListenerTlsProperty
Maybe VirtualNodeConnectionPoolProperty
()
PortMappingProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
haddock_workaround_ :: ()
connectionPool :: Maybe VirtualNodeConnectionPoolProperty
healthCheck :: Maybe HealthCheckProperty
outlierDetection :: Maybe OutlierDetectionProperty
portMapping :: PortMappingProperty
tLS :: Maybe ListenerTlsProperty
..}