{-# 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.OpenSearch.DescribeInboundConnections
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all the inbound cross-cluster search connections for a destination
-- (remote) Amazon OpenSearch Service domain. For more information, see
-- <https://docs.aws.amazon.com/opensearch-service/latest/developerguide/cross-cluster-search.html Cross-cluster search for Amazon OpenSearch Service>.
module Amazonka.OpenSearch.DescribeInboundConnections
  ( -- * Creating a Request
    DescribeInboundConnections (..),
    newDescribeInboundConnections,

    -- * Request Lenses
    describeInboundConnections_filters,
    describeInboundConnections_maxResults,
    describeInboundConnections_nextToken,

    -- * Destructuring the Response
    DescribeInboundConnectionsResponse (..),
    newDescribeInboundConnectionsResponse,

    -- * Response Lenses
    describeInboundConnectionsResponse_connections,
    describeInboundConnectionsResponse_nextToken,
    describeInboundConnectionsResponse_httpStatus,
  )
where

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

-- | Container for the parameters to the @DescribeInboundConnections@
-- operation.
--
-- /See:/ 'newDescribeInboundConnections' smart constructor.
data DescribeInboundConnections = DescribeInboundConnections'
  { -- | A list of filters used to match properties for inbound cross-cluster
    -- connections.
    DescribeInboundConnections -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | An optional parameter that specifies the maximum number of results to
    -- return. You can use @nextToken@ to get the next page of results.
    DescribeInboundConnections -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | If your initial @DescribeInboundConnections@ operation returns a
    -- @nextToken@, you can include the returned @nextToken@ in subsequent
    -- @DescribeInboundConnections@ operations, which returns results in the
    -- next page.
    DescribeInboundConnections -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeInboundConnections -> DescribeInboundConnections -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeInboundConnections -> DescribeInboundConnections -> Bool
$c/= :: DescribeInboundConnections -> DescribeInboundConnections -> Bool
== :: DescribeInboundConnections -> DescribeInboundConnections -> Bool
$c== :: DescribeInboundConnections -> DescribeInboundConnections -> Bool
Prelude.Eq, ReadPrec [DescribeInboundConnections]
ReadPrec DescribeInboundConnections
Int -> ReadS DescribeInboundConnections
ReadS [DescribeInboundConnections]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeInboundConnections]
$creadListPrec :: ReadPrec [DescribeInboundConnections]
readPrec :: ReadPrec DescribeInboundConnections
$creadPrec :: ReadPrec DescribeInboundConnections
readList :: ReadS [DescribeInboundConnections]
$creadList :: ReadS [DescribeInboundConnections]
readsPrec :: Int -> ReadS DescribeInboundConnections
$creadsPrec :: Int -> ReadS DescribeInboundConnections
Prelude.Read, Int -> DescribeInboundConnections -> ShowS
[DescribeInboundConnections] -> ShowS
DescribeInboundConnections -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeInboundConnections] -> ShowS
$cshowList :: [DescribeInboundConnections] -> ShowS
show :: DescribeInboundConnections -> String
$cshow :: DescribeInboundConnections -> String
showsPrec :: Int -> DescribeInboundConnections -> ShowS
$cshowsPrec :: Int -> DescribeInboundConnections -> ShowS
Prelude.Show, forall x.
Rep DescribeInboundConnections x -> DescribeInboundConnections
forall x.
DescribeInboundConnections -> Rep DescribeInboundConnections x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeInboundConnections x -> DescribeInboundConnections
$cfrom :: forall x.
DescribeInboundConnections -> Rep DescribeInboundConnections x
Prelude.Generic)

-- |
-- Create a value of 'DescribeInboundConnections' 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:
--
-- 'filters', 'describeInboundConnections_filters' - A list of filters used to match properties for inbound cross-cluster
-- connections.
--
-- 'maxResults', 'describeInboundConnections_maxResults' - An optional parameter that specifies the maximum number of results to
-- return. You can use @nextToken@ to get the next page of results.
--
-- 'nextToken', 'describeInboundConnections_nextToken' - If your initial @DescribeInboundConnections@ operation returns a
-- @nextToken@, you can include the returned @nextToken@ in subsequent
-- @DescribeInboundConnections@ operations, which returns results in the
-- next page.
newDescribeInboundConnections ::
  DescribeInboundConnections
newDescribeInboundConnections :: DescribeInboundConnections
newDescribeInboundConnections =
  DescribeInboundConnections'
    { $sel:filters:DescribeInboundConnections' :: Maybe [Filter]
filters =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeInboundConnections' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeInboundConnections' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | A list of filters used to match properties for inbound cross-cluster
-- connections.
describeInboundConnections_filters :: Lens.Lens' DescribeInboundConnections (Prelude.Maybe [Filter])
describeInboundConnections_filters :: Lens' DescribeInboundConnections (Maybe [Filter])
describeInboundConnections_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInboundConnections' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeInboundConnections
s@DescribeInboundConnections' {} Maybe [Filter]
a -> DescribeInboundConnections
s {$sel:filters:DescribeInboundConnections' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeInboundConnections) 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 parameter that specifies the maximum number of results to
-- return. You can use @nextToken@ to get the next page of results.
describeInboundConnections_maxResults :: Lens.Lens' DescribeInboundConnections (Prelude.Maybe Prelude.Int)
describeInboundConnections_maxResults :: Lens' DescribeInboundConnections (Maybe Int)
describeInboundConnections_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInboundConnections' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: DescribeInboundConnections
s@DescribeInboundConnections' {} Maybe Int
a -> DescribeInboundConnections
s {$sel:maxResults:DescribeInboundConnections' :: Maybe Int
maxResults = Maybe Int
a} :: DescribeInboundConnections)

-- | If your initial @DescribeInboundConnections@ operation returns a
-- @nextToken@, you can include the returned @nextToken@ in subsequent
-- @DescribeInboundConnections@ operations, which returns results in the
-- next page.
describeInboundConnections_nextToken :: Lens.Lens' DescribeInboundConnections (Prelude.Maybe Prelude.Text)
describeInboundConnections_nextToken :: Lens' DescribeInboundConnections (Maybe Text)
describeInboundConnections_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInboundConnections' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeInboundConnections
s@DescribeInboundConnections' {} Maybe Text
a -> DescribeInboundConnections
s {$sel:nextToken:DescribeInboundConnections' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeInboundConnections)

instance Core.AWSRequest DescribeInboundConnections where
  type
    AWSResponse DescribeInboundConnections =
      DescribeInboundConnectionsResponse
  request :: (Service -> Service)
-> DescribeInboundConnections -> Request DescribeInboundConnections
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeInboundConnections
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeInboundConnections)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [InboundConnection]
-> Maybe Text -> Int -> DescribeInboundConnectionsResponse
DescribeInboundConnectionsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Connections" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"NextToken")
            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 DescribeInboundConnections where
  hashWithSalt :: Int -> DescribeInboundConnections -> Int
hashWithSalt Int
_salt DescribeInboundConnections' {Maybe Int
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
$sel:nextToken:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe Text
$sel:maxResults:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe Int
$sel:filters:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe [Filter]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData DescribeInboundConnections where
  rnf :: DescribeInboundConnections -> ()
rnf DescribeInboundConnections' {Maybe Int
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
$sel:nextToken:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe Text
$sel:maxResults:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe Int
$sel:filters:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe [Filter]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

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

instance Data.ToJSON DescribeInboundConnections where
  toJSON :: DescribeInboundConnections -> Value
toJSON DescribeInboundConnections' {Maybe Int
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
$sel:nextToken:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe Text
$sel:maxResults:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe Int
$sel:filters:DescribeInboundConnections' :: DescribeInboundConnections -> Maybe [Filter]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Filters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Filter]
filters,
            (Key
"MaxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
maxResults,
            (Key
"NextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken
          ]
      )

instance Data.ToPath DescribeInboundConnections where
  toPath :: DescribeInboundConnections -> ByteString
toPath =
    forall a b. a -> b -> a
Prelude.const
      ByteString
"/2021-01-01/opensearch/cc/inboundConnection/search"

instance Data.ToQuery DescribeInboundConnections where
  toQuery :: DescribeInboundConnections -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | Contains a list of connections matching the filter criteria.
--
-- /See:/ 'newDescribeInboundConnectionsResponse' smart constructor.
data DescribeInboundConnectionsResponse = DescribeInboundConnectionsResponse'
  { -- | List of inbound connections.
    DescribeInboundConnectionsResponse -> Maybe [InboundConnection]
connections :: Prelude.Maybe [InboundConnection],
    -- | When @nextToken@ is returned, there are more results available. The
    -- value of @nextToken@ is a unique pagination token for each page. Make
    -- the call again using the returned token to retrieve the next page.
    DescribeInboundConnectionsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeInboundConnectionsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeInboundConnectionsResponse
-> DescribeInboundConnectionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeInboundConnectionsResponse
-> DescribeInboundConnectionsResponse -> Bool
$c/= :: DescribeInboundConnectionsResponse
-> DescribeInboundConnectionsResponse -> Bool
== :: DescribeInboundConnectionsResponse
-> DescribeInboundConnectionsResponse -> Bool
$c== :: DescribeInboundConnectionsResponse
-> DescribeInboundConnectionsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeInboundConnectionsResponse]
ReadPrec DescribeInboundConnectionsResponse
Int -> ReadS DescribeInboundConnectionsResponse
ReadS [DescribeInboundConnectionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeInboundConnectionsResponse]
$creadListPrec :: ReadPrec [DescribeInboundConnectionsResponse]
readPrec :: ReadPrec DescribeInboundConnectionsResponse
$creadPrec :: ReadPrec DescribeInboundConnectionsResponse
readList :: ReadS [DescribeInboundConnectionsResponse]
$creadList :: ReadS [DescribeInboundConnectionsResponse]
readsPrec :: Int -> ReadS DescribeInboundConnectionsResponse
$creadsPrec :: Int -> ReadS DescribeInboundConnectionsResponse
Prelude.Read, Int -> DescribeInboundConnectionsResponse -> ShowS
[DescribeInboundConnectionsResponse] -> ShowS
DescribeInboundConnectionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeInboundConnectionsResponse] -> ShowS
$cshowList :: [DescribeInboundConnectionsResponse] -> ShowS
show :: DescribeInboundConnectionsResponse -> String
$cshow :: DescribeInboundConnectionsResponse -> String
showsPrec :: Int -> DescribeInboundConnectionsResponse -> ShowS
$cshowsPrec :: Int -> DescribeInboundConnectionsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeInboundConnectionsResponse x
-> DescribeInboundConnectionsResponse
forall x.
DescribeInboundConnectionsResponse
-> Rep DescribeInboundConnectionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeInboundConnectionsResponse x
-> DescribeInboundConnectionsResponse
$cfrom :: forall x.
DescribeInboundConnectionsResponse
-> Rep DescribeInboundConnectionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeInboundConnectionsResponse' 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:
--
-- 'connections', 'describeInboundConnectionsResponse_connections' - List of inbound connections.
--
-- 'nextToken', 'describeInboundConnectionsResponse_nextToken' - When @nextToken@ is returned, there are more results available. The
-- value of @nextToken@ is a unique pagination token for each page. Make
-- the call again using the returned token to retrieve the next page.
--
-- 'httpStatus', 'describeInboundConnectionsResponse_httpStatus' - The response's http status code.
newDescribeInboundConnectionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeInboundConnectionsResponse
newDescribeInboundConnectionsResponse :: Int -> DescribeInboundConnectionsResponse
newDescribeInboundConnectionsResponse Int
pHttpStatus_ =
  DescribeInboundConnectionsResponse'
    { $sel:connections:DescribeInboundConnectionsResponse' :: Maybe [InboundConnection]
connections =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeInboundConnectionsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeInboundConnectionsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | List of inbound connections.
describeInboundConnectionsResponse_connections :: Lens.Lens' DescribeInboundConnectionsResponse (Prelude.Maybe [InboundConnection])
describeInboundConnectionsResponse_connections :: Lens'
  DescribeInboundConnectionsResponse (Maybe [InboundConnection])
describeInboundConnectionsResponse_connections = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInboundConnectionsResponse' {Maybe [InboundConnection]
connections :: Maybe [InboundConnection]
$sel:connections:DescribeInboundConnectionsResponse' :: DescribeInboundConnectionsResponse -> Maybe [InboundConnection]
connections} -> Maybe [InboundConnection]
connections) (\s :: DescribeInboundConnectionsResponse
s@DescribeInboundConnectionsResponse' {} Maybe [InboundConnection]
a -> DescribeInboundConnectionsResponse
s {$sel:connections:DescribeInboundConnectionsResponse' :: Maybe [InboundConnection]
connections = Maybe [InboundConnection]
a} :: DescribeInboundConnectionsResponse) 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

-- | When @nextToken@ is returned, there are more results available. The
-- value of @nextToken@ is a unique pagination token for each page. Make
-- the call again using the returned token to retrieve the next page.
describeInboundConnectionsResponse_nextToken :: Lens.Lens' DescribeInboundConnectionsResponse (Prelude.Maybe Prelude.Text)
describeInboundConnectionsResponse_nextToken :: Lens' DescribeInboundConnectionsResponse (Maybe Text)
describeInboundConnectionsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeInboundConnectionsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeInboundConnectionsResponse' :: DescribeInboundConnectionsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeInboundConnectionsResponse
s@DescribeInboundConnectionsResponse' {} Maybe Text
a -> DescribeInboundConnectionsResponse
s {$sel:nextToken:DescribeInboundConnectionsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeInboundConnectionsResponse)

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

instance
  Prelude.NFData
    DescribeInboundConnectionsResponse
  where
  rnf :: DescribeInboundConnectionsResponse -> ()
rnf DescribeInboundConnectionsResponse' {Int
Maybe [InboundConnection]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
connections :: Maybe [InboundConnection]
$sel:httpStatus:DescribeInboundConnectionsResponse' :: DescribeInboundConnectionsResponse -> Int
$sel:nextToken:DescribeInboundConnectionsResponse' :: DescribeInboundConnectionsResponse -> Maybe Text
$sel:connections:DescribeInboundConnectionsResponse' :: DescribeInboundConnectionsResponse -> Maybe [InboundConnection]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [InboundConnection]
connections
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus