module AWS.ELB.LoadBalancer
( describeLoadBalancers
, createLoadBalancer
, deleteLoadBalancer
, attachLoadBalancerToSubnets
, detachLoadBalancerFromSubnets
, applySecurityGroupsToLoadBalancer
, registerInstancesWithLoadBalancer
, deregisterInstancesFromLoadBalancer
, setLoadBalancerListenerSSLCertificate
, createLoadBalancerListeners
, deleteLoadBalancerListeners
) 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"
(HealthCheck
<$> getT "Interval"
<*> getT "Target"
<*> getT "HealthyThreshold"
<*> getT "Timeout"
<*> getT "UnhealthyThreshold"
)
<*> 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 "CookieExpirationPeriod"
<*> getT "PolicyName"
)
)
<*> 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"
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
]