{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
module Amazonka.ELBV2.RemoveListenerCertificates
(
RemoveListenerCertificates (..),
newRemoveListenerCertificates,
removeListenerCertificates_listenerArn,
removeListenerCertificates_certificates,
RemoveListenerCertificatesResponse (..),
newRemoveListenerCertificatesResponse,
removeListenerCertificatesResponse_httpStatus,
)
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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
data RemoveListenerCertificates = RemoveListenerCertificates'
{
RemoveListenerCertificates -> Text
listenerArn :: Prelude.Text,
RemoveListenerCertificates -> [Certificate]
certificates :: [Certificate]
}
deriving (RemoveListenerCertificates -> RemoveListenerCertificates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveListenerCertificates -> RemoveListenerCertificates -> Bool
$c/= :: RemoveListenerCertificates -> RemoveListenerCertificates -> Bool
== :: RemoveListenerCertificates -> RemoveListenerCertificates -> Bool
$c== :: RemoveListenerCertificates -> RemoveListenerCertificates -> Bool
Prelude.Eq, ReadPrec [RemoveListenerCertificates]
ReadPrec RemoveListenerCertificates
Int -> ReadS RemoveListenerCertificates
ReadS [RemoveListenerCertificates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveListenerCertificates]
$creadListPrec :: ReadPrec [RemoveListenerCertificates]
readPrec :: ReadPrec RemoveListenerCertificates
$creadPrec :: ReadPrec RemoveListenerCertificates
readList :: ReadS [RemoveListenerCertificates]
$creadList :: ReadS [RemoveListenerCertificates]
readsPrec :: Int -> ReadS RemoveListenerCertificates
$creadsPrec :: Int -> ReadS RemoveListenerCertificates
Prelude.Read, Int -> RemoveListenerCertificates -> ShowS
[RemoveListenerCertificates] -> ShowS
RemoveListenerCertificates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveListenerCertificates] -> ShowS
$cshowList :: [RemoveListenerCertificates] -> ShowS
show :: RemoveListenerCertificates -> String
$cshow :: RemoveListenerCertificates -> String
showsPrec :: Int -> RemoveListenerCertificates -> ShowS
$cshowsPrec :: Int -> RemoveListenerCertificates -> ShowS
Prelude.Show, forall x.
Rep RemoveListenerCertificates x -> RemoveListenerCertificates
forall x.
RemoveListenerCertificates -> Rep RemoveListenerCertificates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RemoveListenerCertificates x -> RemoveListenerCertificates
$cfrom :: forall x.
RemoveListenerCertificates -> Rep RemoveListenerCertificates x
Prelude.Generic)
newRemoveListenerCertificates ::
Prelude.Text ->
RemoveListenerCertificates
newRemoveListenerCertificates :: Text -> RemoveListenerCertificates
newRemoveListenerCertificates Text
pListenerArn_ =
RemoveListenerCertificates'
{ $sel:listenerArn:RemoveListenerCertificates' :: Text
listenerArn =
Text
pListenerArn_,
$sel:certificates:RemoveListenerCertificates' :: [Certificate]
certificates = forall a. Monoid a => a
Prelude.mempty
}
removeListenerCertificates_listenerArn :: Lens.Lens' RemoveListenerCertificates Prelude.Text
removeListenerCertificates_listenerArn :: Lens' RemoveListenerCertificates Text
removeListenerCertificates_listenerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveListenerCertificates' {Text
listenerArn :: Text
$sel:listenerArn:RemoveListenerCertificates' :: RemoveListenerCertificates -> Text
listenerArn} -> Text
listenerArn) (\s :: RemoveListenerCertificates
s@RemoveListenerCertificates' {} Text
a -> RemoveListenerCertificates
s {$sel:listenerArn:RemoveListenerCertificates' :: Text
listenerArn = Text
a} :: RemoveListenerCertificates)
removeListenerCertificates_certificates :: Lens.Lens' RemoveListenerCertificates [Certificate]
removeListenerCertificates_certificates :: Lens' RemoveListenerCertificates [Certificate]
removeListenerCertificates_certificates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveListenerCertificates' {[Certificate]
certificates :: [Certificate]
$sel:certificates:RemoveListenerCertificates' :: RemoveListenerCertificates -> [Certificate]
certificates} -> [Certificate]
certificates) (\s :: RemoveListenerCertificates
s@RemoveListenerCertificates' {} [Certificate]
a -> RemoveListenerCertificates
s {$sel:certificates:RemoveListenerCertificates' :: [Certificate]
certificates = [Certificate]
a} :: RemoveListenerCertificates) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced
instance Core.AWSRequest RemoveListenerCertificates where
type
AWSResponse RemoveListenerCertificates =
RemoveListenerCertificatesResponse
request :: (Service -> Service)
-> RemoveListenerCertificates -> Request RemoveListenerCertificates
request Service -> Service
overrides =
forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RemoveListenerCertificates
-> ClientResponse ClientBody
-> m (Either
Error (ClientResponse (AWSResponse RemoveListenerCertificates)))
response =
forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
-> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
Text
"RemoveListenerCertificatesResult"
( \Int
s ResponseHeaders
h [Node]
x ->
Int -> RemoveListenerCertificatesResponse
RemoveListenerCertificatesResponse'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
)
instance Prelude.Hashable RemoveListenerCertificates where
hashWithSalt :: Int -> RemoveListenerCertificates -> Int
hashWithSalt Int
_salt RemoveListenerCertificates' {[Certificate]
Text
certificates :: [Certificate]
listenerArn :: Text
$sel:certificates:RemoveListenerCertificates' :: RemoveListenerCertificates -> [Certificate]
$sel:listenerArn:RemoveListenerCertificates' :: RemoveListenerCertificates -> Text
..} =
Int
_salt
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
listenerArn
forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Certificate]
certificates
instance Prelude.NFData RemoveListenerCertificates where
rnf :: RemoveListenerCertificates -> ()
rnf RemoveListenerCertificates' {[Certificate]
Text
certificates :: [Certificate]
listenerArn :: Text
$sel:certificates:RemoveListenerCertificates' :: RemoveListenerCertificates -> [Certificate]
$sel:listenerArn:RemoveListenerCertificates' :: RemoveListenerCertificates -> Text
..} =
forall a. NFData a => a -> ()
Prelude.rnf Text
listenerArn
seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Certificate]
certificates
instance Data.ToHeaders RemoveListenerCertificates where
toHeaders :: RemoveListenerCertificates -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty
instance Data.ToPath RemoveListenerCertificates where
toPath :: RemoveListenerCertificates -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"
instance Data.ToQuery RemoveListenerCertificates where
toQuery :: RemoveListenerCertificates -> QueryString
toQuery RemoveListenerCertificates' {[Certificate]
Text
certificates :: [Certificate]
listenerArn :: Text
$sel:certificates:RemoveListenerCertificates' :: RemoveListenerCertificates -> [Certificate]
$sel:listenerArn:RemoveListenerCertificates' :: RemoveListenerCertificates -> Text
..} =
forall a. Monoid a => [a] -> a
Prelude.mconcat
[ ByteString
"Action"
forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RemoveListenerCertificates" :: Prelude.ByteString),
ByteString
"Version"
forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-12-01" :: Prelude.ByteString),
ByteString
"ListenerArn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
listenerArn,
ByteString
"Certificates"
forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" [Certificate]
certificates
]
data RemoveListenerCertificatesResponse = RemoveListenerCertificatesResponse'
{
RemoveListenerCertificatesResponse -> Int
httpStatus :: Prelude.Int
}
deriving (RemoveListenerCertificatesResponse
-> RemoveListenerCertificatesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveListenerCertificatesResponse
-> RemoveListenerCertificatesResponse -> Bool
$c/= :: RemoveListenerCertificatesResponse
-> RemoveListenerCertificatesResponse -> Bool
== :: RemoveListenerCertificatesResponse
-> RemoveListenerCertificatesResponse -> Bool
$c== :: RemoveListenerCertificatesResponse
-> RemoveListenerCertificatesResponse -> Bool
Prelude.Eq, ReadPrec [RemoveListenerCertificatesResponse]
ReadPrec RemoveListenerCertificatesResponse
Int -> ReadS RemoveListenerCertificatesResponse
ReadS [RemoveListenerCertificatesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveListenerCertificatesResponse]
$creadListPrec :: ReadPrec [RemoveListenerCertificatesResponse]
readPrec :: ReadPrec RemoveListenerCertificatesResponse
$creadPrec :: ReadPrec RemoveListenerCertificatesResponse
readList :: ReadS [RemoveListenerCertificatesResponse]
$creadList :: ReadS [RemoveListenerCertificatesResponse]
readsPrec :: Int -> ReadS RemoveListenerCertificatesResponse
$creadsPrec :: Int -> ReadS RemoveListenerCertificatesResponse
Prelude.Read, Int -> RemoveListenerCertificatesResponse -> ShowS
[RemoveListenerCertificatesResponse] -> ShowS
RemoveListenerCertificatesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveListenerCertificatesResponse] -> ShowS
$cshowList :: [RemoveListenerCertificatesResponse] -> ShowS
show :: RemoveListenerCertificatesResponse -> String
$cshow :: RemoveListenerCertificatesResponse -> String
showsPrec :: Int -> RemoveListenerCertificatesResponse -> ShowS
$cshowsPrec :: Int -> RemoveListenerCertificatesResponse -> ShowS
Prelude.Show, forall x.
Rep RemoveListenerCertificatesResponse x
-> RemoveListenerCertificatesResponse
forall x.
RemoveListenerCertificatesResponse
-> Rep RemoveListenerCertificatesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep RemoveListenerCertificatesResponse x
-> RemoveListenerCertificatesResponse
$cfrom :: forall x.
RemoveListenerCertificatesResponse
-> Rep RemoveListenerCertificatesResponse x
Prelude.Generic)
newRemoveListenerCertificatesResponse ::
Prelude.Int ->
RemoveListenerCertificatesResponse
newRemoveListenerCertificatesResponse :: Int -> RemoveListenerCertificatesResponse
newRemoveListenerCertificatesResponse Int
pHttpStatus_ =
RemoveListenerCertificatesResponse'
{ $sel:httpStatus:RemoveListenerCertificatesResponse' :: Int
httpStatus =
Int
pHttpStatus_
}
removeListenerCertificatesResponse_httpStatus :: Lens.Lens' RemoveListenerCertificatesResponse Prelude.Int
removeListenerCertificatesResponse_httpStatus :: Lens' RemoveListenerCertificatesResponse Int
removeListenerCertificatesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveListenerCertificatesResponse' {Int
httpStatus :: Int
$sel:httpStatus:RemoveListenerCertificatesResponse' :: RemoveListenerCertificatesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: RemoveListenerCertificatesResponse
s@RemoveListenerCertificatesResponse' {} Int
a -> RemoveListenerCertificatesResponse
s {$sel:httpStatus:RemoveListenerCertificatesResponse' :: Int
httpStatus = Int
a} :: RemoveListenerCertificatesResponse)
instance
Prelude.NFData
RemoveListenerCertificatesResponse
where
rnf :: RemoveListenerCertificatesResponse -> ()
rnf RemoveListenerCertificatesResponse' {Int
httpStatus :: Int
$sel:httpStatus:RemoveListenerCertificatesResponse' :: RemoveListenerCertificatesResponse -> Int
..} =
forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus