{-# 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 #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Redshift.DescribeEndpointAccess
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a Redshift-managed VPC endpoint.
--
-- This operation returns paginated results.
module Amazonka.Redshift.DescribeEndpointAccess
  ( -- * Creating a Request
    DescribeEndpointAccess (..),
    newDescribeEndpointAccess,

    -- * Request Lenses
    describeEndpointAccess_clusterIdentifier,
    describeEndpointAccess_endpointName,
    describeEndpointAccess_marker,
    describeEndpointAccess_maxRecords,
    describeEndpointAccess_resourceOwner,
    describeEndpointAccess_vpcId,

    -- * Destructuring the Response
    DescribeEndpointAccessResponse (..),
    newDescribeEndpointAccessResponse,

    -- * Response Lenses
    describeEndpointAccessResponse_endpointAccessList,
    describeEndpointAccessResponse_marker,
    describeEndpointAccessResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.Redshift.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeEndpointAccess' smart constructor.
data DescribeEndpointAccess = DescribeEndpointAccess'
  { -- | The cluster identifier associated with the described endpoint.
    DescribeEndpointAccess -> Maybe Text
clusterIdentifier :: Prelude.Maybe Prelude.Text,
    -- | The name of the endpoint to be described.
    DescribeEndpointAccess -> Maybe Text
endpointName :: Prelude.Maybe Prelude.Text,
    -- | An optional pagination token provided by a previous
    -- @DescribeEndpointAccess@ request. If this parameter is specified, the
    -- response includes only records beyond the marker, up to the value
    -- specified by the @MaxRecords@ parameter.
    DescribeEndpointAccess -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of records to include in the response. If more
    -- records exist than the specified @MaxRecords@ value, a pagination token
    -- called a @Marker@ is included in the response so that the remaining
    -- results can be retrieved.
    DescribeEndpointAccess -> Maybe Int
maxRecords :: Prelude.Maybe Prelude.Int,
    -- | The Amazon Web Services account ID of the owner of the cluster.
    DescribeEndpointAccess -> Maybe Text
resourceOwner :: Prelude.Maybe Prelude.Text,
    -- | The virtual private cloud (VPC) identifier with access to the cluster.
    DescribeEndpointAccess -> Maybe Text
vpcId :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeEndpointAccess -> DescribeEndpointAccess -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEndpointAccess -> DescribeEndpointAccess -> Bool
$c/= :: DescribeEndpointAccess -> DescribeEndpointAccess -> Bool
== :: DescribeEndpointAccess -> DescribeEndpointAccess -> Bool
$c== :: DescribeEndpointAccess -> DescribeEndpointAccess -> Bool
Prelude.Eq, ReadPrec [DescribeEndpointAccess]
ReadPrec DescribeEndpointAccess
Int -> ReadS DescribeEndpointAccess
ReadS [DescribeEndpointAccess]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEndpointAccess]
$creadListPrec :: ReadPrec [DescribeEndpointAccess]
readPrec :: ReadPrec DescribeEndpointAccess
$creadPrec :: ReadPrec DescribeEndpointAccess
readList :: ReadS [DescribeEndpointAccess]
$creadList :: ReadS [DescribeEndpointAccess]
readsPrec :: Int -> ReadS DescribeEndpointAccess
$creadsPrec :: Int -> ReadS DescribeEndpointAccess
Prelude.Read, Int -> DescribeEndpointAccess -> ShowS
[DescribeEndpointAccess] -> ShowS
DescribeEndpointAccess -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEndpointAccess] -> ShowS
$cshowList :: [DescribeEndpointAccess] -> ShowS
show :: DescribeEndpointAccess -> String
$cshow :: DescribeEndpointAccess -> String
showsPrec :: Int -> DescribeEndpointAccess -> ShowS
$cshowsPrec :: Int -> DescribeEndpointAccess -> ShowS
Prelude.Show, forall x. Rep DescribeEndpointAccess x -> DescribeEndpointAccess
forall x. DescribeEndpointAccess -> Rep DescribeEndpointAccess x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeEndpointAccess x -> DescribeEndpointAccess
$cfrom :: forall x. DescribeEndpointAccess -> Rep DescribeEndpointAccess x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEndpointAccess' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'clusterIdentifier', 'describeEndpointAccess_clusterIdentifier' - The cluster identifier associated with the described endpoint.
--
-- 'endpointName', 'describeEndpointAccess_endpointName' - The name of the endpoint to be described.
--
-- 'marker', 'describeEndpointAccess_marker' - An optional pagination token provided by a previous
-- @DescribeEndpointAccess@ request. If this parameter is specified, the
-- response includes only records beyond the marker, up to the value
-- specified by the @MaxRecords@ parameter.
--
-- 'maxRecords', 'describeEndpointAccess_maxRecords' - The maximum number of records to include in the response. If more
-- records exist than the specified @MaxRecords@ value, a pagination token
-- called a @Marker@ is included in the response so that the remaining
-- results can be retrieved.
--
-- 'resourceOwner', 'describeEndpointAccess_resourceOwner' - The Amazon Web Services account ID of the owner of the cluster.
--
-- 'vpcId', 'describeEndpointAccess_vpcId' - The virtual private cloud (VPC) identifier with access to the cluster.
newDescribeEndpointAccess ::
  DescribeEndpointAccess
newDescribeEndpointAccess :: DescribeEndpointAccess
newDescribeEndpointAccess =
  DescribeEndpointAccess'
    { $sel:clusterIdentifier:DescribeEndpointAccess' :: Maybe Text
clusterIdentifier =
        forall a. Maybe a
Prelude.Nothing,
      $sel:endpointName:DescribeEndpointAccess' :: Maybe Text
endpointName = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeEndpointAccess' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxRecords:DescribeEndpointAccess' :: Maybe Int
maxRecords = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceOwner:DescribeEndpointAccess' :: Maybe Text
resourceOwner = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcId:DescribeEndpointAccess' :: Maybe Text
vpcId = forall a. Maybe a
Prelude.Nothing
    }

-- | The cluster identifier associated with the described endpoint.
describeEndpointAccess_clusterIdentifier :: Lens.Lens' DescribeEndpointAccess (Prelude.Maybe Prelude.Text)
describeEndpointAccess_clusterIdentifier :: Lens' DescribeEndpointAccess (Maybe Text)
describeEndpointAccess_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccess' {Maybe Text
clusterIdentifier :: Maybe Text
$sel:clusterIdentifier:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
clusterIdentifier} -> Maybe Text
clusterIdentifier) (\s :: DescribeEndpointAccess
s@DescribeEndpointAccess' {} Maybe Text
a -> DescribeEndpointAccess
s {$sel:clusterIdentifier:DescribeEndpointAccess' :: Maybe Text
clusterIdentifier = Maybe Text
a} :: DescribeEndpointAccess)

-- | The name of the endpoint to be described.
describeEndpointAccess_endpointName :: Lens.Lens' DescribeEndpointAccess (Prelude.Maybe Prelude.Text)
describeEndpointAccess_endpointName :: Lens' DescribeEndpointAccess (Maybe Text)
describeEndpointAccess_endpointName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccess' {Maybe Text
endpointName :: Maybe Text
$sel:endpointName:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
endpointName} -> Maybe Text
endpointName) (\s :: DescribeEndpointAccess
s@DescribeEndpointAccess' {} Maybe Text
a -> DescribeEndpointAccess
s {$sel:endpointName:DescribeEndpointAccess' :: Maybe Text
endpointName = Maybe Text
a} :: DescribeEndpointAccess)

-- | An optional pagination token provided by a previous
-- @DescribeEndpointAccess@ request. If this parameter is specified, the
-- response includes only records beyond the marker, up to the value
-- specified by the @MaxRecords@ parameter.
describeEndpointAccess_marker :: Lens.Lens' DescribeEndpointAccess (Prelude.Maybe Prelude.Text)
describeEndpointAccess_marker :: Lens' DescribeEndpointAccess (Maybe Text)
describeEndpointAccess_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccess' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeEndpointAccess
s@DescribeEndpointAccess' {} Maybe Text
a -> DescribeEndpointAccess
s {$sel:marker:DescribeEndpointAccess' :: Maybe Text
marker = Maybe Text
a} :: DescribeEndpointAccess)

-- | The maximum number of records to include in the response. If more
-- records exist than the specified @MaxRecords@ value, a pagination token
-- called a @Marker@ is included in the response so that the remaining
-- results can be retrieved.
describeEndpointAccess_maxRecords :: Lens.Lens' DescribeEndpointAccess (Prelude.Maybe Prelude.Int)
describeEndpointAccess_maxRecords :: Lens' DescribeEndpointAccess (Maybe Int)
describeEndpointAccess_maxRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccess' {Maybe Int
maxRecords :: Maybe Int
$sel:maxRecords:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Int
maxRecords} -> Maybe Int
maxRecords) (\s :: DescribeEndpointAccess
s@DescribeEndpointAccess' {} Maybe Int
a -> DescribeEndpointAccess
s {$sel:maxRecords:DescribeEndpointAccess' :: Maybe Int
maxRecords = Maybe Int
a} :: DescribeEndpointAccess)

-- | The Amazon Web Services account ID of the owner of the cluster.
describeEndpointAccess_resourceOwner :: Lens.Lens' DescribeEndpointAccess (Prelude.Maybe Prelude.Text)
describeEndpointAccess_resourceOwner :: Lens' DescribeEndpointAccess (Maybe Text)
describeEndpointAccess_resourceOwner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccess' {Maybe Text
resourceOwner :: Maybe Text
$sel:resourceOwner:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
resourceOwner} -> Maybe Text
resourceOwner) (\s :: DescribeEndpointAccess
s@DescribeEndpointAccess' {} Maybe Text
a -> DescribeEndpointAccess
s {$sel:resourceOwner:DescribeEndpointAccess' :: Maybe Text
resourceOwner = Maybe Text
a} :: DescribeEndpointAccess)

-- | The virtual private cloud (VPC) identifier with access to the cluster.
describeEndpointAccess_vpcId :: Lens.Lens' DescribeEndpointAccess (Prelude.Maybe Prelude.Text)
describeEndpointAccess_vpcId :: Lens' DescribeEndpointAccess (Maybe Text)
describeEndpointAccess_vpcId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccess' {Maybe Text
vpcId :: Maybe Text
$sel:vpcId:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
vpcId} -> Maybe Text
vpcId) (\s :: DescribeEndpointAccess
s@DescribeEndpointAccess' {} Maybe Text
a -> DescribeEndpointAccess
s {$sel:vpcId:DescribeEndpointAccess' :: Maybe Text
vpcId = Maybe Text
a} :: DescribeEndpointAccess)

instance Core.AWSPager DescribeEndpointAccess where
  page :: DescribeEndpointAccess
-> AWSResponse DescribeEndpointAccess
-> Maybe DescribeEndpointAccess
page DescribeEndpointAccess
rq AWSResponse DescribeEndpointAccess
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeEndpointAccess
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeEndpointAccessResponse (Maybe Text)
describeEndpointAccessResponse_marker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeEndpointAccess
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeEndpointAccessResponse (Maybe [EndpointAccess])
describeEndpointAccessResponse_endpointAccessList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeEndpointAccess
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeEndpointAccess (Maybe Text)
describeEndpointAccess_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeEndpointAccess
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeEndpointAccessResponse (Maybe Text)
describeEndpointAccessResponse_marker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest DescribeEndpointAccess where
  type
    AWSResponse DescribeEndpointAccess =
      DescribeEndpointAccessResponse
  request :: (Service -> Service)
-> DescribeEndpointAccess -> Request DescribeEndpointAccess
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 DescribeEndpointAccess
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeEndpointAccess)))
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
"DescribeEndpointAccessResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [EndpointAccess]
-> Maybe Text -> Int -> DescribeEndpointAccessResponse
DescribeEndpointAccessResponse'
            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
"EndpointAccessList"
                            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
"Marker")
            forall (f :: * -> *) a b. Applicative f => 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 DescribeEndpointAccess where
  hashWithSalt :: Int -> DescribeEndpointAccess -> Int
hashWithSalt Int
_salt DescribeEndpointAccess' {Maybe Int
Maybe Text
vpcId :: Maybe Text
resourceOwner :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
endpointName :: Maybe Text
clusterIdentifier :: Maybe Text
$sel:vpcId:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:resourceOwner:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:maxRecords:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Int
$sel:marker:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:endpointName:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:clusterIdentifier:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endpointName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxRecords
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceOwner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
vpcId

instance Prelude.NFData DescribeEndpointAccess where
  rnf :: DescribeEndpointAccess -> ()
rnf DescribeEndpointAccess' {Maybe Int
Maybe Text
vpcId :: Maybe Text
resourceOwner :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
endpointName :: Maybe Text
clusterIdentifier :: Maybe Text
$sel:vpcId:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:resourceOwner:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:maxRecords:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Int
$sel:marker:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:endpointName:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:clusterIdentifier:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endpointName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxRecords
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceOwner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
vpcId

instance Data.ToHeaders DescribeEndpointAccess where
  toHeaders :: DescribeEndpointAccess -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DescribeEndpointAccess where
  toPath :: DescribeEndpointAccess -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery DescribeEndpointAccess where
  toQuery :: DescribeEndpointAccess -> QueryString
toQuery DescribeEndpointAccess' {Maybe Int
Maybe Text
vpcId :: Maybe Text
resourceOwner :: Maybe Text
maxRecords :: Maybe Int
marker :: Maybe Text
endpointName :: Maybe Text
clusterIdentifier :: Maybe Text
$sel:vpcId:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:resourceOwner:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:maxRecords:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Int
$sel:marker:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:endpointName:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
$sel:clusterIdentifier:DescribeEndpointAccess' :: DescribeEndpointAccess -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeEndpointAccess" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clusterIdentifier,
        ByteString
"EndpointName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
endpointName,
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxRecords" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxRecords,
        ByteString
"ResourceOwner" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
resourceOwner,
        ByteString
"VpcId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
vpcId
      ]

-- | /See:/ 'newDescribeEndpointAccessResponse' smart constructor.
data DescribeEndpointAccessResponse = DescribeEndpointAccessResponse'
  { -- | The list of endpoints with access to the cluster.
    DescribeEndpointAccessResponse -> Maybe [EndpointAccess]
endpointAccessList :: Prelude.Maybe [EndpointAccess],
    -- | An optional pagination token provided by a previous
    -- @DescribeEndpointAccess@ request. If this parameter is specified, the
    -- response includes only records beyond the marker, up to the value
    -- specified by the @MaxRecords@ parameter.
    DescribeEndpointAccessResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeEndpointAccessResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeEndpointAccessResponse
-> DescribeEndpointAccessResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeEndpointAccessResponse
-> DescribeEndpointAccessResponse -> Bool
$c/= :: DescribeEndpointAccessResponse
-> DescribeEndpointAccessResponse -> Bool
== :: DescribeEndpointAccessResponse
-> DescribeEndpointAccessResponse -> Bool
$c== :: DescribeEndpointAccessResponse
-> DescribeEndpointAccessResponse -> Bool
Prelude.Eq, ReadPrec [DescribeEndpointAccessResponse]
ReadPrec DescribeEndpointAccessResponse
Int -> ReadS DescribeEndpointAccessResponse
ReadS [DescribeEndpointAccessResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeEndpointAccessResponse]
$creadListPrec :: ReadPrec [DescribeEndpointAccessResponse]
readPrec :: ReadPrec DescribeEndpointAccessResponse
$creadPrec :: ReadPrec DescribeEndpointAccessResponse
readList :: ReadS [DescribeEndpointAccessResponse]
$creadList :: ReadS [DescribeEndpointAccessResponse]
readsPrec :: Int -> ReadS DescribeEndpointAccessResponse
$creadsPrec :: Int -> ReadS DescribeEndpointAccessResponse
Prelude.Read, Int -> DescribeEndpointAccessResponse -> ShowS
[DescribeEndpointAccessResponse] -> ShowS
DescribeEndpointAccessResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeEndpointAccessResponse] -> ShowS
$cshowList :: [DescribeEndpointAccessResponse] -> ShowS
show :: DescribeEndpointAccessResponse -> String
$cshow :: DescribeEndpointAccessResponse -> String
showsPrec :: Int -> DescribeEndpointAccessResponse -> ShowS
$cshowsPrec :: Int -> DescribeEndpointAccessResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeEndpointAccessResponse x
-> DescribeEndpointAccessResponse
forall x.
DescribeEndpointAccessResponse
-> Rep DescribeEndpointAccessResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeEndpointAccessResponse x
-> DescribeEndpointAccessResponse
$cfrom :: forall x.
DescribeEndpointAccessResponse
-> Rep DescribeEndpointAccessResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeEndpointAccessResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'endpointAccessList', 'describeEndpointAccessResponse_endpointAccessList' - The list of endpoints with access to the cluster.
--
-- 'marker', 'describeEndpointAccessResponse_marker' - An optional pagination token provided by a previous
-- @DescribeEndpointAccess@ request. If this parameter is specified, the
-- response includes only records beyond the marker, up to the value
-- specified by the @MaxRecords@ parameter.
--
-- 'httpStatus', 'describeEndpointAccessResponse_httpStatus' - The response's http status code.
newDescribeEndpointAccessResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeEndpointAccessResponse
newDescribeEndpointAccessResponse :: Int -> DescribeEndpointAccessResponse
newDescribeEndpointAccessResponse Int
pHttpStatus_ =
  DescribeEndpointAccessResponse'
    { $sel:endpointAccessList:DescribeEndpointAccessResponse' :: Maybe [EndpointAccess]
endpointAccessList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DescribeEndpointAccessResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeEndpointAccessResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of endpoints with access to the cluster.
describeEndpointAccessResponse_endpointAccessList :: Lens.Lens' DescribeEndpointAccessResponse (Prelude.Maybe [EndpointAccess])
describeEndpointAccessResponse_endpointAccessList :: Lens' DescribeEndpointAccessResponse (Maybe [EndpointAccess])
describeEndpointAccessResponse_endpointAccessList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccessResponse' {Maybe [EndpointAccess]
endpointAccessList :: Maybe [EndpointAccess]
$sel:endpointAccessList:DescribeEndpointAccessResponse' :: DescribeEndpointAccessResponse -> Maybe [EndpointAccess]
endpointAccessList} -> Maybe [EndpointAccess]
endpointAccessList) (\s :: DescribeEndpointAccessResponse
s@DescribeEndpointAccessResponse' {} Maybe [EndpointAccess]
a -> DescribeEndpointAccessResponse
s {$sel:endpointAccessList:DescribeEndpointAccessResponse' :: Maybe [EndpointAccess]
endpointAccessList = Maybe [EndpointAccess]
a} :: DescribeEndpointAccessResponse) 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

-- | An optional pagination token provided by a previous
-- @DescribeEndpointAccess@ request. If this parameter is specified, the
-- response includes only records beyond the marker, up to the value
-- specified by the @MaxRecords@ parameter.
describeEndpointAccessResponse_marker :: Lens.Lens' DescribeEndpointAccessResponse (Prelude.Maybe Prelude.Text)
describeEndpointAccessResponse_marker :: Lens' DescribeEndpointAccessResponse (Maybe Text)
describeEndpointAccessResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccessResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:DescribeEndpointAccessResponse' :: DescribeEndpointAccessResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DescribeEndpointAccessResponse
s@DescribeEndpointAccessResponse' {} Maybe Text
a -> DescribeEndpointAccessResponse
s {$sel:marker:DescribeEndpointAccessResponse' :: Maybe Text
marker = Maybe Text
a} :: DescribeEndpointAccessResponse)

-- | The response's http status code.
describeEndpointAccessResponse_httpStatus :: Lens.Lens' DescribeEndpointAccessResponse Prelude.Int
describeEndpointAccessResponse_httpStatus :: Lens' DescribeEndpointAccessResponse Int
describeEndpointAccessResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeEndpointAccessResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeEndpointAccessResponse' :: DescribeEndpointAccessResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeEndpointAccessResponse
s@DescribeEndpointAccessResponse' {} Int
a -> DescribeEndpointAccessResponse
s {$sel:httpStatus:DescribeEndpointAccessResponse' :: Int
httpStatus = Int
a} :: DescribeEndpointAccessResponse)

instance
  Prelude.NFData
    DescribeEndpointAccessResponse
  where
  rnf :: DescribeEndpointAccessResponse -> ()
rnf DescribeEndpointAccessResponse' {Int
Maybe [EndpointAccess]
Maybe Text
httpStatus :: Int
marker :: Maybe Text
endpointAccessList :: Maybe [EndpointAccess]
$sel:httpStatus:DescribeEndpointAccessResponse' :: DescribeEndpointAccessResponse -> Int
$sel:marker:DescribeEndpointAccessResponse' :: DescribeEndpointAccessResponse -> Maybe Text
$sel:endpointAccessList:DescribeEndpointAccessResponse' :: DescribeEndpointAccessResponse -> Maybe [EndpointAccess]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [EndpointAccess]
endpointAccessList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus