{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Amazonka.ELBV2.Types.TargetGroup where
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ELBV2.Types.Matcher
import Amazonka.ELBV2.Types.ProtocolEnum
import Amazonka.ELBV2.Types.TargetGroupIpAddressTypeEnum
import Amazonka.ELBV2.Types.TargetTypeEnum
import qualified Amazonka.Prelude as Prelude
data TargetGroup = TargetGroup'
{
TargetGroup -> Maybe Bool
healthCheckEnabled :: Prelude.Maybe Prelude.Bool,
TargetGroup -> Maybe Natural
healthCheckIntervalSeconds :: Prelude.Maybe Prelude.Natural,
TargetGroup -> Maybe Text
healthCheckPath :: Prelude.Maybe Prelude.Text,
TargetGroup -> Maybe Text
healthCheckPort :: Prelude.Maybe Prelude.Text,
TargetGroup -> Maybe ProtocolEnum
healthCheckProtocol :: Prelude.Maybe ProtocolEnum,
TargetGroup -> Maybe Natural
healthCheckTimeoutSeconds :: Prelude.Maybe Prelude.Natural,
TargetGroup -> Maybe Natural
healthyThresholdCount :: Prelude.Maybe Prelude.Natural,
TargetGroup -> Maybe TargetGroupIpAddressTypeEnum
ipAddressType :: Prelude.Maybe TargetGroupIpAddressTypeEnum,
TargetGroup -> Maybe [Text]
loadBalancerArns :: Prelude.Maybe [Prelude.Text],
TargetGroup -> Maybe Matcher
matcher :: Prelude.Maybe Matcher,
TargetGroup -> Maybe Natural
port :: Prelude.Maybe Prelude.Natural,
TargetGroup -> Maybe ProtocolEnum
protocol :: Prelude.Maybe ProtocolEnum,
TargetGroup -> Maybe Text
protocolVersion :: Prelude.Maybe Prelude.Text,
TargetGroup -> Maybe Text
targetGroupArn :: Prelude.Maybe Prelude.Text,
TargetGroup -> Maybe Text
targetGroupName :: Prelude.Maybe Prelude.Text,
TargetGroup -> Maybe TargetTypeEnum
targetType :: Prelude.Maybe TargetTypeEnum,
TargetGroup -> Maybe Natural
unhealthyThresholdCount :: Prelude.Maybe Prelude.Natural,
TargetGroup -> Maybe Text
vpcId :: Prelude.Maybe Prelude.Text
}
deriving (TargetGroup -> TargetGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetGroup -> TargetGroup -> Bool
$c/= :: TargetGroup -> TargetGroup -> Bool
== :: TargetGroup -> TargetGroup -> Bool
$c== :: TargetGroup -> TargetGroup -> Bool
Prelude.Eq, ReadPrec [TargetGroup]
ReadPrec TargetGroup
Int -> ReadS TargetGroup
ReadS [TargetGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TargetGroup]
$creadListPrec :: ReadPrec [TargetGroup]
readPrec :: ReadPrec TargetGroup
$creadPrec :: ReadPrec TargetGroup
readList :: ReadS [TargetGroup]
$creadList :: ReadS [TargetGroup]
readsPrec :: Int -> ReadS TargetGroup
$creadsPrec :: Int -> ReadS TargetGroup
Prelude.Read, Int -> TargetGroup -> ShowS
[TargetGroup] -> ShowS
TargetGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetGroup] -> ShowS
$cshowList :: [TargetGroup] -> ShowS
show :: TargetGroup -> String
$cshow :: TargetGroup -> String
showsPrec :: Int -> TargetGroup -> ShowS
$cshowsPrec :: Int -> TargetGroup -> ShowS
Prelude.Show, forall x. Rep TargetGroup x -> TargetGroup
forall x. TargetGroup -> Rep TargetGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TargetGroup x -> TargetGroup
$cfrom :: forall x. TargetGroup -> Rep TargetGroup x
Prelude.Generic)
newTargetGroup ::
TargetGroup
newTargetGroup :: TargetGroup
newTargetGroup =
TargetGroup'
{ $sel:healthCheckEnabled:TargetGroup' :: Maybe Bool
healthCheckEnabled = forall a. Maybe a
Prelude.Nothing,
$sel:healthCheckIntervalSeconds:TargetGroup' :: Maybe Natural
healthCheckIntervalSeconds = forall a. Maybe a
Prelude.Nothing,
$sel:healthCheckPath:TargetGroup' :: Maybe Text
healthCheckPath = forall a. Maybe a
Prelude.Nothing,
$sel:healthCheckPort:TargetGroup' :: Maybe Text
healthCheckPort = forall a. Maybe a
Prelude.Nothing,
$sel:healthCheckProtocol:TargetGroup' :: Maybe ProtocolEnum
healthCheckProtocol = forall a. Maybe a
Prelude.Nothing,
$sel:healthCheckTimeoutSeconds:TargetGroup' :: Maybe Natural
healthCheckTimeoutSeconds = forall a. Maybe a
Prelude.Nothing,
$sel:healthyThresholdCount:TargetGroup' :: Maybe Natural
healthyThresholdCount = forall a. Maybe a
Prelude.Nothing,
$sel:ipAddressType:TargetGroup' :: Maybe TargetGroupIpAddressTypeEnum
ipAddressType = forall a. Maybe a
Prelude.Nothing,
$sel:loadBalancerArns:TargetGroup' :: Maybe [Text]
loadBalancerArns = forall a. Maybe a
Prelude.Nothing,
$sel:matcher:TargetGroup' :: Maybe Matcher
matcher = forall a. Maybe a
Prelude.Nothing,
$sel:port:TargetGroup' :: Maybe Natural
port = forall a. Maybe a
Prelude.Nothing,
$sel:protocol:TargetGroup' :: Maybe ProtocolEnum
protocol = forall a. Maybe a
Prelude.Nothing,
$sel:protocolVersion:TargetGroup' :: Maybe Text
protocolVersion = forall a. Maybe a
Prelude.Nothing,
$sel:targetGroupArn:TargetGroup' :: Maybe Text
targetGroupArn = forall a. Maybe a
Prelude.Nothing,
$sel:targetGroupName:TargetGroup' :: Maybe Text
targetGroupName = forall a. Maybe a
Prelude.Nothing,
$sel:targetType:TargetGroup' :: Maybe TargetTypeEnum
targetType = forall a. Maybe a
Prelude.Nothing,
$sel:unhealthyThresholdCount:TargetGroup' :: Maybe Natural
unhealthyThresholdCount = forall a. Maybe a
Prelude.Nothing,
$sel:vpcId:TargetGroup' :: Maybe Text
vpcId = forall a. Maybe a
Prelude.Nothing
}
targetGroup_healthCheckEnabled :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Bool)
targetGroup_healthCheckEnabled :: Lens' TargetGroup (Maybe Bool)
targetGroup_healthCheckEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Bool
healthCheckEnabled :: Maybe Bool
$sel:healthCheckEnabled:TargetGroup' :: TargetGroup -> Maybe Bool
healthCheckEnabled} -> Maybe Bool
healthCheckEnabled) (\s :: TargetGroup
s@TargetGroup' {} Maybe Bool
a -> TargetGroup
s {$sel:healthCheckEnabled:TargetGroup' :: Maybe Bool
healthCheckEnabled = Maybe Bool
a} :: TargetGroup)
targetGroup_healthCheckIntervalSeconds :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Natural)
targetGroup_healthCheckIntervalSeconds :: Lens' TargetGroup (Maybe Natural)
targetGroup_healthCheckIntervalSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Natural
healthCheckIntervalSeconds :: Maybe Natural
$sel:healthCheckIntervalSeconds:TargetGroup' :: TargetGroup -> Maybe Natural
healthCheckIntervalSeconds} -> Maybe Natural
healthCheckIntervalSeconds) (\s :: TargetGroup
s@TargetGroup' {} Maybe Natural
a -> TargetGroup
s {$sel:healthCheckIntervalSeconds:TargetGroup' :: Maybe Natural
healthCheckIntervalSeconds = Maybe Natural
a} :: TargetGroup)
targetGroup_healthCheckPath :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Text)
targetGroup_healthCheckPath :: Lens' TargetGroup (Maybe Text)
targetGroup_healthCheckPath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Text
healthCheckPath :: Maybe Text
$sel:healthCheckPath:TargetGroup' :: TargetGroup -> Maybe Text
healthCheckPath} -> Maybe Text
healthCheckPath) (\s :: TargetGroup
s@TargetGroup' {} Maybe Text
a -> TargetGroup
s {$sel:healthCheckPath:TargetGroup' :: Maybe Text
healthCheckPath = Maybe Text
a} :: TargetGroup)
targetGroup_healthCheckPort :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Text)
targetGroup_healthCheckPort :: Lens' TargetGroup (Maybe Text)
targetGroup_healthCheckPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Text
healthCheckPort :: Maybe Text
$sel:healthCheckPort:TargetGroup' :: TargetGroup -> Maybe Text
healthCheckPort} -> Maybe Text
healthCheckPort) (\s :: TargetGroup
s@TargetGroup' {} Maybe Text
a -> TargetGroup
s {$sel:healthCheckPort:TargetGroup' :: Maybe Text
healthCheckPort = Maybe Text
a} :: TargetGroup)
targetGroup_healthCheckProtocol :: Lens.Lens' TargetGroup (Prelude.Maybe ProtocolEnum)
targetGroup_healthCheckProtocol :: Lens' TargetGroup (Maybe ProtocolEnum)
targetGroup_healthCheckProtocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe ProtocolEnum
healthCheckProtocol :: Maybe ProtocolEnum
$sel:healthCheckProtocol:TargetGroup' :: TargetGroup -> Maybe ProtocolEnum
healthCheckProtocol} -> Maybe ProtocolEnum
healthCheckProtocol) (\s :: TargetGroup
s@TargetGroup' {} Maybe ProtocolEnum
a -> TargetGroup
s {$sel:healthCheckProtocol:TargetGroup' :: Maybe ProtocolEnum
healthCheckProtocol = Maybe ProtocolEnum
a} :: TargetGroup)
targetGroup_healthCheckTimeoutSeconds :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Natural)
targetGroup_healthCheckTimeoutSeconds :: Lens' TargetGroup (Maybe Natural)
targetGroup_healthCheckTimeoutSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Natural
healthCheckTimeoutSeconds :: Maybe Natural
$sel:healthCheckTimeoutSeconds:TargetGroup' :: TargetGroup -> Maybe Natural
healthCheckTimeoutSeconds} -> Maybe Natural
healthCheckTimeoutSeconds) (\s :: TargetGroup
s@TargetGroup' {} Maybe Natural
a -> TargetGroup
s {$sel:healthCheckTimeoutSeconds:TargetGroup' :: Maybe Natural
healthCheckTimeoutSeconds = Maybe Natural
a} :: TargetGroup)
targetGroup_healthyThresholdCount :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Natural)
targetGroup_healthyThresholdCount :: Lens' TargetGroup (Maybe Natural)
targetGroup_healthyThresholdCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Natural
healthyThresholdCount :: Maybe Natural
$sel:healthyThresholdCount:TargetGroup' :: TargetGroup -> Maybe Natural
healthyThresholdCount} -> Maybe Natural
healthyThresholdCount) (\s :: TargetGroup
s@TargetGroup' {} Maybe Natural
a -> TargetGroup
s {$sel:healthyThresholdCount:TargetGroup' :: Maybe Natural
healthyThresholdCount = Maybe Natural
a} :: TargetGroup)
targetGroup_ipAddressType :: Lens.Lens' TargetGroup (Prelude.Maybe TargetGroupIpAddressTypeEnum)
targetGroup_ipAddressType :: Lens' TargetGroup (Maybe TargetGroupIpAddressTypeEnum)
targetGroup_ipAddressType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe TargetGroupIpAddressTypeEnum
ipAddressType :: Maybe TargetGroupIpAddressTypeEnum
$sel:ipAddressType:TargetGroup' :: TargetGroup -> Maybe TargetGroupIpAddressTypeEnum
ipAddressType} -> Maybe TargetGroupIpAddressTypeEnum
ipAddressType) (\s :: TargetGroup
s@TargetGroup' {} Maybe TargetGroupIpAddressTypeEnum
a -> TargetGroup
s {$sel:ipAddressType:TargetGroup' :: Maybe TargetGroupIpAddressTypeEnum
ipAddressType = Maybe TargetGroupIpAddressTypeEnum
a} :: TargetGroup)
targetGroup_loadBalancerArns :: Lens.Lens' TargetGroup (Prelude.Maybe [Prelude.Text])
targetGroup_loadBalancerArns :: Lens' TargetGroup (Maybe [Text])
targetGroup_loadBalancerArns = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe [Text]
loadBalancerArns :: Maybe [Text]
$sel:loadBalancerArns:TargetGroup' :: TargetGroup -> Maybe [Text]
loadBalancerArns} -> Maybe [Text]
loadBalancerArns) (\s :: TargetGroup
s@TargetGroup' {} Maybe [Text]
a -> TargetGroup
s {$sel:loadBalancerArns:TargetGroup' :: Maybe [Text]
loadBalancerArns = Maybe [Text]
a} :: TargetGroup) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced
targetGroup_matcher :: Lens.Lens' TargetGroup (Prelude.Maybe Matcher)
targetGroup_matcher :: Lens' TargetGroup (Maybe Matcher)
targetGroup_matcher = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Matcher
matcher :: Maybe Matcher
$sel:matcher:TargetGroup' :: TargetGroup -> Maybe Matcher
matcher} -> Maybe Matcher
matcher) (\s :: TargetGroup
s@TargetGroup' {} Maybe Matcher
a -> TargetGroup
s {$sel:matcher:TargetGroup' :: Maybe Matcher
matcher = Maybe Matcher
a} :: TargetGroup)
targetGroup_port :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Natural)
targetGroup_port :: Lens' TargetGroup (Maybe Natural)
targetGroup_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Natural
port :: Maybe Natural
$sel:port:TargetGroup' :: TargetGroup -> Maybe Natural
port} -> Maybe Natural
port) (\s :: TargetGroup
s@TargetGroup' {} Maybe Natural
a -> TargetGroup
s {$sel:port:TargetGroup' :: Maybe Natural
port = Maybe Natural
a} :: TargetGroup)
targetGroup_protocol :: Lens.Lens' TargetGroup (Prelude.Maybe ProtocolEnum)
targetGroup_protocol :: Lens' TargetGroup (Maybe ProtocolEnum)
targetGroup_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe ProtocolEnum
protocol :: Maybe ProtocolEnum
$sel:protocol:TargetGroup' :: TargetGroup -> Maybe ProtocolEnum
protocol} -> Maybe ProtocolEnum
protocol) (\s :: TargetGroup
s@TargetGroup' {} Maybe ProtocolEnum
a -> TargetGroup
s {$sel:protocol:TargetGroup' :: Maybe ProtocolEnum
protocol = Maybe ProtocolEnum
a} :: TargetGroup)
targetGroup_protocolVersion :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Text)
targetGroup_protocolVersion :: Lens' TargetGroup (Maybe Text)
targetGroup_protocolVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Text
protocolVersion :: Maybe Text
$sel:protocolVersion:TargetGroup' :: TargetGroup -> Maybe Text
protocolVersion} -> Maybe Text
protocolVersion) (\s :: TargetGroup
s@TargetGroup' {} Maybe Text
a -> TargetGroup
s {$sel:protocolVersion:TargetGroup' :: Maybe Text
protocolVersion = Maybe Text
a} :: TargetGroup)
targetGroup_targetGroupArn :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Text)
targetGroup_targetGroupArn :: Lens' TargetGroup (Maybe Text)
targetGroup_targetGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Text
targetGroupArn :: Maybe Text
$sel:targetGroupArn:TargetGroup' :: TargetGroup -> Maybe Text
targetGroupArn} -> Maybe Text
targetGroupArn) (\s :: TargetGroup
s@TargetGroup' {} Maybe Text
a -> TargetGroup
s {$sel:targetGroupArn:TargetGroup' :: Maybe Text
targetGroupArn = Maybe Text
a} :: TargetGroup)
targetGroup_targetGroupName :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Text)
targetGroup_targetGroupName :: Lens' TargetGroup (Maybe Text)
targetGroup_targetGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Text
targetGroupName :: Maybe Text
$sel:targetGroupName:TargetGroup' :: TargetGroup -> Maybe Text
targetGroupName} -> Maybe Text
targetGroupName) (\s :: TargetGroup
s@TargetGroup' {} Maybe Text
a -> TargetGroup
s {$sel:targetGroupName:TargetGroup' :: Maybe Text
targetGroupName = Maybe Text
a} :: TargetGroup)
targetGroup_targetType :: Lens.Lens' TargetGroup (Prelude.Maybe TargetTypeEnum)
targetGroup_targetType :: Lens' TargetGroup (Maybe TargetTypeEnum)
targetGroup_targetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe TargetTypeEnum
targetType :: Maybe TargetTypeEnum
$sel:targetType:TargetGroup' :: TargetGroup -> Maybe TargetTypeEnum
targetType} -> Maybe TargetTypeEnum
targetType) (\s :: TargetGroup
s@TargetGroup' {} Maybe TargetTypeEnum
a -> TargetGroup
s {$sel:targetType:TargetGroup' :: Maybe TargetTypeEnum
targetType = Maybe TargetTypeEnum
a} :: TargetGroup)
targetGroup_unhealthyThresholdCount :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Natural)
targetGroup_unhealthyThresholdCount :: Lens' TargetGroup (Maybe Natural)
targetGroup_unhealthyThresholdCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Natural
unhealthyThresholdCount :: Maybe Natural
$sel:unhealthyThresholdCount:TargetGroup' :: TargetGroup -> Maybe Natural
unhealthyThresholdCount} -> Maybe Natural
unhealthyThresholdCount) (\s :: TargetGroup
s@TargetGroup' {} Maybe Natural
a -> TargetGroup
s {$sel:unhealthyThresholdCount:TargetGroup' :: Maybe Natural
unhealthyThresholdCount = Maybe Natural
a} :: TargetGroup)
targetGroup_vpcId :: Lens.Lens' TargetGroup (Prelude.Maybe Prelude.Text)
targetGroup_vpcId :: Lens' TargetGroup (Maybe Text)
targetGroup_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGroup' {Maybe Text
vpcId :: Maybe Text
$sel:vpcId:TargetGroup' :: TargetGroup -> Maybe Text
vpcId} -> Maybe Text
vpcId) (\s :: TargetGroup
s@TargetGroup' {} Maybe Text
a -> TargetGroup
s {$sel:vpcId:TargetGroup' :: Maybe Text
vpcId = Maybe Text
a} :: TargetGroup)
instance Data.FromXML TargetGroup where
parseXML :: [Node] -> Either String TargetGroup
parseXML [Node]
x =
Maybe Bool
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe ProtocolEnum
-> Maybe Natural
-> Maybe Natural
-> Maybe TargetGroupIpAddressTypeEnum
-> Maybe [Text]
-> Maybe Matcher
-> Maybe Natural
-> Maybe ProtocolEnum
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe TargetTypeEnum
-> Maybe Natural
-> Maybe Text
-> TargetGroup
TargetGroup'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HealthCheckEnabled")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HealthCheckIntervalSeconds")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HealthCheckPath")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HealthCheckPort")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HealthCheckProtocol")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HealthCheckTimeoutSeconds")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"HealthyThresholdCount")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"IpAddressType")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"LoadBalancerArns"
forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Matcher")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Port")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Protocol")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"ProtocolVersion")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"TargetGroupArn")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"TargetGroupName")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"TargetType")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"UnhealthyThresholdCount")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"VpcId")
instance Prelude.Hashable TargetGroup where
hashWithSalt :: Int -> TargetGroup -> Int
hashWithSalt Int
_salt TargetGroup' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe Text
Maybe Matcher
Maybe ProtocolEnum
Maybe TargetGroupIpAddressTypeEnum
Maybe TargetTypeEnum
vpcId :: Maybe Text
unhealthyThresholdCount :: Maybe Natural
targetType :: Maybe TargetTypeEnum
targetGroupName :: Maybe Text
targetGroupArn :: Maybe Text
protocolVersion :: Maybe Text
protocol :: Maybe ProtocolEnum
port :: Maybe Natural
matcher :: Maybe Matcher
loadBalancerArns :: Maybe [Text]
ipAddressType :: Maybe TargetGroupIpAddressTypeEnum
healthyThresholdCount :: Maybe Natural
healthCheckTimeoutSeconds :: Maybe Natural
healthCheckProtocol :: Maybe ProtocolEnum
healthCheckPort :: Maybe Text
healthCheckPath :: Maybe Text
healthCheckIntervalSeconds :: Maybe Natural
healthCheckEnabled :: Maybe Bool
$sel:vpcId:TargetGroup' :: TargetGroup -> Maybe Text
$sel:unhealthyThresholdCount:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:targetType:TargetGroup' :: TargetGroup -> Maybe TargetTypeEnum
$sel:targetGroupName:TargetGroup' :: TargetGroup -> Maybe Text
$sel:targetGroupArn:TargetGroup' :: TargetGroup -> Maybe Text
$sel:protocolVersion:TargetGroup' :: TargetGroup -> Maybe Text
$sel:protocol:TargetGroup' :: TargetGroup -> Maybe ProtocolEnum
$sel:port:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:matcher:TargetGroup' :: TargetGroup -> Maybe Matcher
$sel:loadBalancerArns:TargetGroup' :: TargetGroup -> Maybe [Text]
$sel:ipAddressType:TargetGroup' :: TargetGroup -> Maybe TargetGroupIpAddressTypeEnum
$sel:healthyThresholdCount:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:healthCheckTimeoutSeconds:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:healthCheckProtocol:TargetGroup' :: TargetGroup -> Maybe ProtocolEnum
$sel:healthCheckPort:TargetGroup' :: TargetGroup -> Maybe Text
$sel:healthCheckPath:TargetGroup' :: TargetGroup -> Maybe Text
$sel:healthCheckIntervalSeconds:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:healthCheckEnabled:TargetGroup' :: TargetGroup -> Maybe Bool
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
healthCheckEnabled
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
healthCheckIntervalSeconds
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
healthCheckPath
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
healthCheckPort
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProtocolEnum
healthCheckProtocol
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
healthCheckTimeoutSeconds
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
healthyThresholdCount
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetGroupIpAddressTypeEnum
ipAddressType
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
loadBalancerArns
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Matcher
matcher
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
port
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProtocolEnum
protocol
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
protocolVersion
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetGroupArn
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
targetGroupName
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetTypeEnum
targetType
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
unhealthyThresholdCount
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcId
instance Prelude.NFData TargetGroup where
rnf :: TargetGroup -> ()
rnf TargetGroup' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe Text
Maybe Matcher
Maybe ProtocolEnum
Maybe TargetGroupIpAddressTypeEnum
Maybe TargetTypeEnum
vpcId :: Maybe Text
unhealthyThresholdCount :: Maybe Natural
targetType :: Maybe TargetTypeEnum
targetGroupName :: Maybe Text
targetGroupArn :: Maybe Text
protocolVersion :: Maybe Text
protocol :: Maybe ProtocolEnum
port :: Maybe Natural
matcher :: Maybe Matcher
loadBalancerArns :: Maybe [Text]
ipAddressType :: Maybe TargetGroupIpAddressTypeEnum
healthyThresholdCount :: Maybe Natural
healthCheckTimeoutSeconds :: Maybe Natural
healthCheckProtocol :: Maybe ProtocolEnum
healthCheckPort :: Maybe Text
healthCheckPath :: Maybe Text
healthCheckIntervalSeconds :: Maybe Natural
healthCheckEnabled :: Maybe Bool
$sel:vpcId:TargetGroup' :: TargetGroup -> Maybe Text
$sel:unhealthyThresholdCount:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:targetType:TargetGroup' :: TargetGroup -> Maybe TargetTypeEnum
$sel:targetGroupName:TargetGroup' :: TargetGroup -> Maybe Text
$sel:targetGroupArn:TargetGroup' :: TargetGroup -> Maybe Text
$sel:protocolVersion:TargetGroup' :: TargetGroup -> Maybe Text
$sel:protocol:TargetGroup' :: TargetGroup -> Maybe ProtocolEnum
$sel:port:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:matcher:TargetGroup' :: TargetGroup -> Maybe Matcher
$sel:loadBalancerArns:TargetGroup' :: TargetGroup -> Maybe [Text]
$sel:ipAddressType:TargetGroup' :: TargetGroup -> Maybe TargetGroupIpAddressTypeEnum
$sel:healthyThresholdCount:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:healthCheckTimeoutSeconds:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:healthCheckProtocol:TargetGroup' :: TargetGroup -> Maybe ProtocolEnum
$sel:healthCheckPort:TargetGroup' :: TargetGroup -> Maybe Text
$sel:healthCheckPath:TargetGroup' :: TargetGroup -> Maybe Text
$sel:healthCheckIntervalSeconds:TargetGroup' :: TargetGroup -> Maybe Natural
$sel:healthCheckEnabled:TargetGroup' :: TargetGroup -> Maybe Bool
..} =
forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
healthCheckEnabled
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
healthCheckIntervalSeconds
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
healthCheckPath
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
healthCheckPort
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProtocolEnum
healthCheckProtocol
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
healthCheckTimeoutSeconds
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
healthyThresholdCount
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetGroupIpAddressTypeEnum
ipAddressType
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
loadBalancerArns
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Matcher
matcher
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
port
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProtocolEnum
protocol
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
protocolVersion
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetGroupArn
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
targetGroupName
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetTypeEnum
targetType
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
unhealthyThresholdCount
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpcId