module AWS.ELB.LoadBalancer
( describeLoadBalancers
, createLoadBalancer
, deleteLoadBalancer
, attachLoadBalancerToSubnets
, detachLoadBalancerFromSubnets
, applySecurityGroupsToLoadBalancer
, registerInstancesWithLoadBalancer
, deregisterInstancesFromLoadBalancer
, setLoadBalancerListenerSSLCertificate
, createLoadBalancerListeners
, deleteLoadBalancerListeners
, describeLoadBalancerPolicies
, describeLoadBalancerPolicyTypes
, createLoadBalancerPolicy
, deleteLoadBalancerPolicy
, describeInstanceHealth
, configureHealthCheck
, enableAvailabilityZonesForLoadBalancer
, disableAvailabilityZonesForLoadBalancer
, createLBCookieStickinessPolicy
, createAppCookieStickinessPolicy
, setLoadBalancerPoliciesOfListener
, setLoadBalancerPoliciesForBackendServer
) where
import Data.Text (Text)
import Data.IP (IPv4, AddrRange)
import Data.Conduit
import Control.Applicative
import Data.XML.Types (Event(..))
import AWS.Lib.Parser
import AWS.Lib.Query
import AWS.ELB.Types
import AWS.ELB.Internal
import AWS.Util (toText)
describeLoadBalancers
:: (MonadBaseControl IO m, MonadResource m)
=> [Text]
-> Maybe Text
-> ELB m [LoadBalancer]
describeLoadBalancers lbs marker =
elbQuery "DescribeLoadBalancers" params sinkLoadBalancers
where
params =
[ "LoadBalancerNames.member" |.#= lbs
, "Marker" |=? marker
]
sinkLoadBalancers :: MonadThrow m
=> GLSink Event m [LoadBalancer]
sinkLoadBalancers = members "LoadBalancerDescriptions" $
LoadBalancer
<$> members "SecurityGroups" text
<*> getT "CreatedTime"
<*> getT "LoadBalancerName"
<*> element "HealthCheck" sinkHealthCheck
<*> getT "VPCId"
<*> members "ListenerDescriptions"
(ListenerDescription
<$> members "PolicyNames" text
<*> element "Listener"
(Listener
<$> getT "Protocol"
<*> getT "LoadBalancerPort"
<*> getT "InstanceProtocol"
<*> getT "SSLCertificateId"
<*> getT "InstancePort"
)
)
<*> members "Instances" sinkInstance
<*> element "Policies"
(Policies
<$> members "AppCookieStickinessPolicies"
(AppCookieStickinessPolicy
<$> getT "CookieName"
<*> getT "PolicyName"
)
<*> members "OtherPolicies" text
<*> members "LBCookieStickinessPolicies"
(LBCookieStickinessPolicy
<$> getT "PolicyName"
<*> getT "CookieExpirationPeriod"
)
)
<*> members "AvailabilityZones" text
<*> getT "CanonicalHostedZoneName"
<*> getT "CanonicalHostedZoneNameID"
<*> getT "Scheme"
<*> elementM "SourceSecurityGroup"
(SourceSecurityGroup
<$> getT "OwnerAlias"
<*> getT "GroupName"
)
<*> getT "DNSName"
<*> members "BackendServerDescriptions"
(BackendServerDescription
<$> getT "InstancePort"
<*> members "PolicyNames" text
)
<*> members "Subnets" text
sinkInstance :: MonadThrow m => GLSink Event m Instance
sinkInstance = Instance <$> getT "InstanceId"
sinkHealthCheck :: MonadThrow m => GLSink Event m HealthCheck
sinkHealthCheck =
HealthCheck
<$> getT "Interval"
<*> getT "Target"
<*> getT "HealthyThreshold"
<*> getT "Timeout"
<*> getT "UnhealthyThreshold"
createLoadBalancer
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> [Listener]
-> [Text]
-> Maybe Text
-> [Text]
-> [AddrRange IPv4]
-> ELB m Text
createLoadBalancer name listeners zones scheme groups subnets =
elbQuery "CreateLoadBalancer" params $ getT "DNSName"
where
params =
[ "LoadBalancerName" |= name
, "Listeners.member" |.#. listeners'
, "AvailabilityZones.member" |.#= zones
, "Scheme" |=? scheme
, "SecurityGroups.member" |.#= groups
, "Subnets.member" |.#= map toText subnets
]
listeners' = flip map listeners $
\(Listener prot lbport iprot cert iport) ->
[ "Protocol" |= prot
, "LoadBalancerPort" |= toText lbport
, "InstanceProtocol" |= iprot
, "SSLCertificateId" |=? cert
, "InstancePort" |= toText iport
]
deleteLoadBalancer
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> ELB m ()
deleteLoadBalancer name = elbQuery "DeleteLoadBalancer" params $
getT_ "DeleteLoadBalancerResult"
where
params = ["LoadBalancerName" |= name]
attachLoadBalancerToSubnets
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> [Text]
-> ELB m [Text]
attachLoadBalancerToSubnets name subnets =
elbQuery "AttachLoadBalancerToSubnets" params $ members "Subnets" text
where
params =
[ "LoadBalancerName" |= name
, "Subnets.member" |.#= subnets
]
detachLoadBalancerFromSubnets
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> [Text]
-> ELB m [Text]
detachLoadBalancerFromSubnets name subnets =
elbQuery "DetachLoadBalancerFromSubnets" params $ members "Subnets" text
where
params =
[ "LoadBalancerName" |= name
, "Subnets.member" |.#= subnets
]
applySecurityGroupsToLoadBalancer
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> [Text]
-> ELB m [Text]
applySecurityGroupsToLoadBalancer name sgs =
elbQuery "ApplySecurityGroupsToLoadBalancer" params $ members "SecurityGroups" text
where
params =
[ "LoadBalancerName" |= name
, "SecurityGroups.member" |.#= sgs
]
registerInstancesWithLoadBalancer
:: (MonadBaseControl IO m, MonadResource m)
=> [Text]
-> Text
-> ELB m [Instance]
registerInstancesWithLoadBalancer insts name =
elbQuery "RegisterInstancesWithLoadBalancer" params $ members "Instances" sinkInstance
where
params =
[ "Instances.member" |.#. map toInstanceParam insts
, "LoadBalancerName" |= name
]
toInstanceParam :: Text -> [QueryParam]
toInstanceParam inst = ["InstanceId" |= inst ]
deregisterInstancesFromLoadBalancer
:: (MonadBaseControl IO m, MonadResource m)
=> [Text]
-> Text
-> ELB m [Instance]
deregisterInstancesFromLoadBalancer insts name =
elbQuery "DeregisterInstancesFromLoadBalancer" params $ members "Instances" sinkInstance
where
params =
[ "Instances.member" |.#. map toInstanceParam insts
, "LoadBalancerName" |= name
]
setLoadBalancerListenerSSLCertificate
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> Int
-> Text
-> ELB m ()
setLoadBalancerListenerSSLCertificate lb port cert =
elbQuery "SetLoadBalancerListenerSSLCertificate" params $ getT_ "SetLoadBalancerListenerSSLCertificateResult"
where
params =
[ "LoadBalancerName" |= lb
, "LoadBalancerPort" |= toText port
, "SSLCertificateId" |= cert
]
createLoadBalancerListeners
:: (MonadBaseControl IO m, MonadResource m)
=> [Listener]
-> Text
-> ELB m ()
createLoadBalancerListeners listeners lb =
elbQuery "CreateLoadBalancerListeners" params $ getT_ "CreateLoadBalancerListenersResult"
where
params =
[ "Listeners.member" |.#. map toListenerParam listeners
, "LoadBalancerName" |= lb
]
toListenerParam :: Listener -> [QueryParam]
toListenerParam Listener{..} =
[ "Protocol" |= listenerProtocol
, "LoadBalancerPort" |= toText listenerLoadBalancerPort
, "InstanceProtocol" |= listenerInstanceProtocol
, "SSLCertificateId" |=? listenerSSLCertificateId
, "InstancePort" |= toText listenerInstancePort
]
deleteLoadBalancerListeners
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> [Int]
-> ELB m ()
deleteLoadBalancerListeners lb ports =
elbQuery "DeleteLoadBalancerListeners" params $ getT_ "DeleteLoadBalancerListenersResult"
where
params =
[ "LoadBalancerName" |= lb
, "LoadBalancerPorts.member" |.#= map toText ports
]
describeLoadBalancerPolicies
:: (MonadBaseControl IO m, MonadResource m)
=> Maybe Text
-> [Text]
-> ELB m [PolicyDescription]
describeLoadBalancerPolicies mlb policies =
elbQuery "DescribeLoadBalancerPolicies" params $ members "PolicyDescriptions" sinkPolicyDescription
where
params =
[ "LoadBalancerName" |=? mlb
, "PolicyNames.member" |.#= policies
]
sinkPolicyDescription :: MonadThrow m => GLSink Event m PolicyDescription
sinkPolicyDescription =
PolicyDescription
<$> getT "PolicyName"
<*> getT "PolicyTypeName"
<*> members "PolicyAttributeDescriptions" sinkPolicyAttribute
sinkPolicyAttribute :: MonadThrow m => GLSink Event m PolicyAttribute
sinkPolicyAttribute =
PolicyAttribute
<$> getT "AttributeName"
<*> getT "AttributeValue"
describeLoadBalancerPolicyTypes
:: (MonadBaseControl IO m, MonadResource m)
=> [Text]
-> ELB m [PolicyType]
describeLoadBalancerPolicyTypes typeNames =
elbQuery "DescribeLoadBalancerPolicyTypes" params $ members "PolicyTypeDescriptions" sinkPolicyType
where
params = ["PolicyTypeNames.member" |.#= typeNames]
sinkPolicyType :: MonadThrow m => GLSink Event m PolicyType
sinkPolicyType =
PolicyType
<$> members "PolicyAttributeTypeDescriptions" sinkPolicyAttributeType
<*> getT "PolicyTypeName"
<*> getT "Description"
sinkPolicyAttributeType :: MonadThrow m => GLSink Event m PolicyAttributeType
sinkPolicyAttributeType =
PolicyAttributeType
<$> getT "AttributeName"
<*> getT "AttributeType"
<*> getT "DefaultValue"
<*> getT "Cardinality"
<*> getT "Description"
createLoadBalancerPolicy
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> [PolicyAttribute]
-> Text
-> Text
-> ELB m ()
createLoadBalancerPolicy lb attrs name typeName =
elbQuery "CreateLoadBalancerPolicy" params $ getT_ "CreateLoadBalancerPolicyResult"
where
params =
[ "LoadBalancerName" |= lb
, "PolicyAttributes.member" |.#. map toAttributeParams attrs
, "PolicyName" |= name
, "PolicyTypeName" |= typeName
]
toAttributeParams :: PolicyAttribute -> [QueryParam]
toAttributeParams PolicyAttribute{..} =
[ "AttributeName" |= policyAttributeName
, "AttributeValue" |= policyAttributeValue
]
deleteLoadBalancerPolicy
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> Text
-> ELB m ()
deleteLoadBalancerPolicy lb policyName =
elbQuery "DeleteLoadBalancerPolicy" params $ getT_ "DeleteLoadBalancerPolicyResult"
where
params =
[ "LoadBalancerName" |= lb
, "PolicyName" |= policyName
]
describeInstanceHealth
:: (MonadBaseControl IO m, MonadResource m)
=> [Text]
-> Text
-> ELB m [InstanceState]
describeInstanceHealth insts lb =
elbQuery "DescribeInstanceHealth" params $ members "InstanceStates" sinkInstanceState
where
params =
[ "Instances.member" |.#. map toInstanceParam insts
, "LoadBalancerName" |= lb
]
sinkInstanceState :: MonadThrow m => GLSink Event m InstanceState
sinkInstanceState =
InstanceState
<$> getT "Description"
<*> getT "InstanceId"
<*> getT "State"
<*> getT "ReasonCode"
configureHealthCheck
:: (MonadBaseControl IO m, MonadResource m)
=> HealthCheck
-> Text
-> ELB m HealthCheck
configureHealthCheck hc lb =
elbQuery "ConfigureHealthCheck" params $ element "HealthCheck" sinkHealthCheck
where
params =
[ "HealthCheck" |. toHealthCheckParams hc
, "LoadBalancerName" |= lb
]
toHealthCheckParams :: HealthCheck -> [QueryParam]
toHealthCheckParams HealthCheck{..} =
[ "HealthyThreshold" |= toText healthCheckHealthyThreshold
, "Interval" |= toText healthCheckInterval
, "Target" |= healthCheckTarget
, "Timeout" |= toText healthCheckTimeout
, "UnhealthyThreshold" |= toText healthCheckUnhealthyThreshold
]
enableAvailabilityZonesForLoadBalancer
:: (MonadBaseControl IO m, MonadResource m)
=> [Text]
-> Text
-> ELB m [Text]
enableAvailabilityZonesForLoadBalancer zones lb =
elbQuery "EnableAvailabilityZonesForLoadBalancer" params $ members "AvailabilityZones" text
where
params =
[ "AvailabilityZones.member" |.#= zones
, "LoadBalancerName" |= lb
]
disableAvailabilityZonesForLoadBalancer
:: (MonadBaseControl IO m, MonadResource m)
=> [Text]
-> Text
-> ELB m [Text]
disableAvailabilityZonesForLoadBalancer zones lb =
elbQuery "DisableAvailabilityZonesForLoadBalancer" params $ members "AvailabilityZones" text
where
params =
[ "AvailabilityZones.member" |.#= zones
, "LoadBalancerName" |= lb
]
createLBCookieStickinessPolicy
:: (MonadBaseControl IO m, MonadResource m)
=> Maybe Int
-> Text
-> Text
-> ELB m ()
createLBCookieStickinessPolicy period lb policy =
elbQuery "CreateLBCookieStickinessPolicy" params $ getT_ "CreateLBCookieStickinessPolicyResult"
where
params =
[ "CookieExpirationPeriod" |=? toText <$> period
, "LoadBalancerName" |= lb
, "PolicyName" |= policy
]
createAppCookieStickinessPolicy
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> Text
-> Text
-> ELB m ()
createAppCookieStickinessPolicy cookieName lb policy =
elbQuery "CreateAppCookieStickinessPolicy" params $ getT_ "CreateAppCookieStickinessPolicyResult"
where
params =
[ "CookieName" |= cookieName
, "LoadBalancerName" |= lb
, "PolicyName" |= policy
]
setLoadBalancerPoliciesOfListener
:: (MonadBaseControl IO m, MonadResource m)
=> Text
-> Int
-> [Text]
-> ELB m ()
setLoadBalancerPoliciesOfListener lb port policies =
elbQuery "SetLoadBalancerPoliciesOfListener" params $ getT_ "SetLoadBalancerPoliciesOfListenerResult"
where
params =
[ "LoadBalancerName" |= lb
, "LoadBalancerPort" |= toText port
, if null policies then "PolicyNames" |= "" else "PolicyNames.member" |.#= policies
]
setLoadBalancerPoliciesForBackendServer
:: (MonadBaseControl IO m, MonadResource m)
=> Int
-> Text
-> [Text]
-> ELB m ()
setLoadBalancerPoliciesForBackendServer port lb policies =
elbQuery "SetLoadBalancerPoliciesForBackendServer" params $ getT_ "SetLoadBalancerPoliciesForBackendServerResult"
where
params =
[ "InstancePort" |= toText port
, "LoadBalancerName" |= lb
, "PolicyNames.member" |.#= policies
]