{-# 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.PinpointSmsVoiceV2.DescribePools
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves the specified pools or all pools associated with your Amazon
-- Web Services account.
--
-- If you specify pool IDs, the output includes information for only the
-- specified pools. If you specify filters, the output includes information
-- for only those pools that meet the filter criteria. If you don\'t
-- specify pool IDs or filters, the output includes information for all
-- pools.
--
-- If you specify a pool ID that isn\'t valid, an Error is returned.
--
-- A pool is a collection of phone numbers and SenderIds. A pool can
-- include one or more phone numbers and SenderIds that are associated with
-- your Amazon Web Services account.
--
-- This operation returns paginated results.
module Amazonka.PinpointSmsVoiceV2.DescribePools
  ( -- * Creating a Request
    DescribePools (..),
    newDescribePools,

    -- * Request Lenses
    describePools_filters,
    describePools_maxResults,
    describePools_nextToken,
    describePools_poolIds,

    -- * Destructuring the Response
    DescribePoolsResponse (..),
    newDescribePoolsResponse,

    -- * Response Lenses
    describePoolsResponse_nextToken,
    describePoolsResponse_pools,
    describePoolsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribePools' smart constructor.
data DescribePools = DescribePools'
  { -- | An array of PoolFilter objects to filter the results.
    DescribePools -> Maybe [PoolFilter]
filters :: Prelude.Maybe [PoolFilter],
    -- | The maximum number of results to return per each request.
    DescribePools -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to be used for the next set of paginated results. You don\'t
    -- need to supply a value for this field in the initial request.
    DescribePools -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of pools to find. This is an array of strings that
    -- can be either the PoolId or PoolArn.
    DescribePools -> Maybe [Text]
poolIds :: Prelude.Maybe [Prelude.Text]
  }
  deriving (DescribePools -> DescribePools -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePools -> DescribePools -> Bool
$c/= :: DescribePools -> DescribePools -> Bool
== :: DescribePools -> DescribePools -> Bool
$c== :: DescribePools -> DescribePools -> Bool
Prelude.Eq, ReadPrec [DescribePools]
ReadPrec DescribePools
Int -> ReadS DescribePools
ReadS [DescribePools]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePools]
$creadListPrec :: ReadPrec [DescribePools]
readPrec :: ReadPrec DescribePools
$creadPrec :: ReadPrec DescribePools
readList :: ReadS [DescribePools]
$creadList :: ReadS [DescribePools]
readsPrec :: Int -> ReadS DescribePools
$creadsPrec :: Int -> ReadS DescribePools
Prelude.Read, Int -> DescribePools -> ShowS
[DescribePools] -> ShowS
DescribePools -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePools] -> ShowS
$cshowList :: [DescribePools] -> ShowS
show :: DescribePools -> String
$cshow :: DescribePools -> String
showsPrec :: Int -> DescribePools -> ShowS
$cshowsPrec :: Int -> DescribePools -> ShowS
Prelude.Show, forall x. Rep DescribePools x -> DescribePools
forall x. DescribePools -> Rep DescribePools x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePools x -> DescribePools
$cfrom :: forall x. DescribePools -> Rep DescribePools x
Prelude.Generic)

-- |
-- Create a value of 'DescribePools' 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', 'describePools_filters' - An array of PoolFilter objects to filter the results.
--
-- 'maxResults', 'describePools_maxResults' - The maximum number of results to return per each request.
--
-- 'nextToken', 'describePools_nextToken' - The token to be used for the next set of paginated results. You don\'t
-- need to supply a value for this field in the initial request.
--
-- 'poolIds', 'describePools_poolIds' - The unique identifier of pools to find. This is an array of strings that
-- can be either the PoolId or PoolArn.
newDescribePools ::
  DescribePools
newDescribePools :: DescribePools
newDescribePools =
  DescribePools'
    { $sel:filters:DescribePools' :: Maybe [PoolFilter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribePools' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribePools' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:poolIds:DescribePools' :: Maybe [Text]
poolIds = forall a. Maybe a
Prelude.Nothing
    }

-- | An array of PoolFilter objects to filter the results.
describePools_filters :: Lens.Lens' DescribePools (Prelude.Maybe [PoolFilter])
describePools_filters :: Lens' DescribePools (Maybe [PoolFilter])
describePools_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePools' {Maybe [PoolFilter]
filters :: Maybe [PoolFilter]
$sel:filters:DescribePools' :: DescribePools -> Maybe [PoolFilter]
filters} -> Maybe [PoolFilter]
filters) (\s :: DescribePools
s@DescribePools' {} Maybe [PoolFilter]
a -> DescribePools
s {$sel:filters:DescribePools' :: Maybe [PoolFilter]
filters = Maybe [PoolFilter]
a} :: DescribePools) 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

-- | The maximum number of results to return per each request.
describePools_maxResults :: Lens.Lens' DescribePools (Prelude.Maybe Prelude.Natural)
describePools_maxResults :: Lens' DescribePools (Maybe Natural)
describePools_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePools' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribePools' :: DescribePools -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribePools
s@DescribePools' {} Maybe Natural
a -> DescribePools
s {$sel:maxResults:DescribePools' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribePools)

-- | The token to be used for the next set of paginated results. You don\'t
-- need to supply a value for this field in the initial request.
describePools_nextToken :: Lens.Lens' DescribePools (Prelude.Maybe Prelude.Text)
describePools_nextToken :: Lens' DescribePools (Maybe Text)
describePools_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePools' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribePools' :: DescribePools -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribePools
s@DescribePools' {} Maybe Text
a -> DescribePools
s {$sel:nextToken:DescribePools' :: Maybe Text
nextToken = Maybe Text
a} :: DescribePools)

-- | The unique identifier of pools to find. This is an array of strings that
-- can be either the PoolId or PoolArn.
describePools_poolIds :: Lens.Lens' DescribePools (Prelude.Maybe [Prelude.Text])
describePools_poolIds :: Lens' DescribePools (Maybe [Text])
describePools_poolIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePools' {Maybe [Text]
poolIds :: Maybe [Text]
$sel:poolIds:DescribePools' :: DescribePools -> Maybe [Text]
poolIds} -> Maybe [Text]
poolIds) (\s :: DescribePools
s@DescribePools' {} Maybe [Text]
a -> DescribePools
s {$sel:poolIds:DescribePools' :: Maybe [Text]
poolIds = Maybe [Text]
a} :: DescribePools) 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

instance Core.AWSPager DescribePools where
  page :: DescribePools -> AWSResponse DescribePools -> Maybe DescribePools
page DescribePools
rq AWSResponse DescribePools
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribePools
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribePoolsResponse (Maybe Text)
describePoolsResponse_nextToken
            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 DescribePools
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribePoolsResponse (Maybe [PoolInformation])
describePoolsResponse_pools
            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.$ DescribePools
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribePools (Maybe Text)
describePools_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribePools
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribePoolsResponse (Maybe Text)
describePoolsResponse_nextToken
          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 DescribePools where
  type
    AWSResponse DescribePools =
      DescribePoolsResponse
  request :: (Service -> Service) -> DescribePools -> Request DescribePools
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 DescribePools
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribePools)))
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 Text
-> Maybe [PoolInformation] -> Int -> DescribePoolsResponse
DescribePoolsResponse'
            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
"NextToken")
            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
"Pools" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable DescribePools where
  hashWithSalt :: Int -> DescribePools -> Int
hashWithSalt Int
_salt DescribePools' {Maybe Natural
Maybe [Text]
Maybe [PoolFilter]
Maybe Text
poolIds :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [PoolFilter]
$sel:poolIds:DescribePools' :: DescribePools -> Maybe [Text]
$sel:nextToken:DescribePools' :: DescribePools -> Maybe Text
$sel:maxResults:DescribePools' :: DescribePools -> Maybe Natural
$sel:filters:DescribePools' :: DescribePools -> Maybe [PoolFilter]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PoolFilter]
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
poolIds

instance Prelude.NFData DescribePools where
  rnf :: DescribePools -> ()
rnf DescribePools' {Maybe Natural
Maybe [Text]
Maybe [PoolFilter]
Maybe Text
poolIds :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [PoolFilter]
$sel:poolIds:DescribePools' :: DescribePools -> Maybe [Text]
$sel:nextToken:DescribePools' :: DescribePools -> Maybe Text
$sel:maxResults:DescribePools' :: DescribePools -> Maybe Natural
$sel:filters:DescribePools' :: DescribePools -> Maybe [PoolFilter]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [PoolFilter]
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      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 Maybe [Text]
poolIds

instance Data.ToHeaders DescribePools where
  toHeaders :: DescribePools -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"PinpointSMSVoiceV2.DescribePools" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DescribePools where
  toJSON :: DescribePools -> Value
toJSON DescribePools' {Maybe Natural
Maybe [Text]
Maybe [PoolFilter]
Maybe Text
poolIds :: Maybe [Text]
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe [PoolFilter]
$sel:poolIds:DescribePools' :: DescribePools -> Maybe [Text]
$sel:nextToken:DescribePools' :: DescribePools -> Maybe Text
$sel:maxResults:DescribePools' :: DescribePools -> Maybe Natural
$sel:filters:DescribePools' :: DescribePools -> Maybe [PoolFilter]
..} =
    [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 [PoolFilter]
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 Natural
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,
            (Key
"PoolIds" 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]
poolIds
          ]
      )

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

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

-- | /See:/ 'newDescribePoolsResponse' smart constructor.
data DescribePoolsResponse = DescribePoolsResponse'
  { -- | The token to be used for the next set of paginated results. If this
    -- field is empty then there are no more results.
    DescribePoolsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An array of PoolInformation objects that contain the details for the
    -- requested pools.
    DescribePoolsResponse -> Maybe [PoolInformation]
pools :: Prelude.Maybe [PoolInformation],
    -- | The response's http status code.
    DescribePoolsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribePoolsResponse -> DescribePoolsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePoolsResponse -> DescribePoolsResponse -> Bool
$c/= :: DescribePoolsResponse -> DescribePoolsResponse -> Bool
== :: DescribePoolsResponse -> DescribePoolsResponse -> Bool
$c== :: DescribePoolsResponse -> DescribePoolsResponse -> Bool
Prelude.Eq, ReadPrec [DescribePoolsResponse]
ReadPrec DescribePoolsResponse
Int -> ReadS DescribePoolsResponse
ReadS [DescribePoolsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePoolsResponse]
$creadListPrec :: ReadPrec [DescribePoolsResponse]
readPrec :: ReadPrec DescribePoolsResponse
$creadPrec :: ReadPrec DescribePoolsResponse
readList :: ReadS [DescribePoolsResponse]
$creadList :: ReadS [DescribePoolsResponse]
readsPrec :: Int -> ReadS DescribePoolsResponse
$creadsPrec :: Int -> ReadS DescribePoolsResponse
Prelude.Read, Int -> DescribePoolsResponse -> ShowS
[DescribePoolsResponse] -> ShowS
DescribePoolsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePoolsResponse] -> ShowS
$cshowList :: [DescribePoolsResponse] -> ShowS
show :: DescribePoolsResponse -> String
$cshow :: DescribePoolsResponse -> String
showsPrec :: Int -> DescribePoolsResponse -> ShowS
$cshowsPrec :: Int -> DescribePoolsResponse -> ShowS
Prelude.Show, forall x. Rep DescribePoolsResponse x -> DescribePoolsResponse
forall x. DescribePoolsResponse -> Rep DescribePoolsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePoolsResponse x -> DescribePoolsResponse
$cfrom :: forall x. DescribePoolsResponse -> Rep DescribePoolsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePoolsResponse' 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:
--
-- 'nextToken', 'describePoolsResponse_nextToken' - The token to be used for the next set of paginated results. If this
-- field is empty then there are no more results.
--
-- 'pools', 'describePoolsResponse_pools' - An array of PoolInformation objects that contain the details for the
-- requested pools.
--
-- 'httpStatus', 'describePoolsResponse_httpStatus' - The response's http status code.
newDescribePoolsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribePoolsResponse
newDescribePoolsResponse :: Int -> DescribePoolsResponse
newDescribePoolsResponse Int
pHttpStatus_ =
  DescribePoolsResponse'
    { $sel:nextToken:DescribePoolsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pools:DescribePoolsResponse' :: Maybe [PoolInformation]
pools = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribePoolsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token to be used for the next set of paginated results. If this
-- field is empty then there are no more results.
describePoolsResponse_nextToken :: Lens.Lens' DescribePoolsResponse (Prelude.Maybe Prelude.Text)
describePoolsResponse_nextToken :: Lens' DescribePoolsResponse (Maybe Text)
describePoolsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePoolsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribePoolsResponse' :: DescribePoolsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribePoolsResponse
s@DescribePoolsResponse' {} Maybe Text
a -> DescribePoolsResponse
s {$sel:nextToken:DescribePoolsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribePoolsResponse)

-- | An array of PoolInformation objects that contain the details for the
-- requested pools.
describePoolsResponse_pools :: Lens.Lens' DescribePoolsResponse (Prelude.Maybe [PoolInformation])
describePoolsResponse_pools :: Lens' DescribePoolsResponse (Maybe [PoolInformation])
describePoolsResponse_pools = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePoolsResponse' {Maybe [PoolInformation]
pools :: Maybe [PoolInformation]
$sel:pools:DescribePoolsResponse' :: DescribePoolsResponse -> Maybe [PoolInformation]
pools} -> Maybe [PoolInformation]
pools) (\s :: DescribePoolsResponse
s@DescribePoolsResponse' {} Maybe [PoolInformation]
a -> DescribePoolsResponse
s {$sel:pools:DescribePoolsResponse' :: Maybe [PoolInformation]
pools = Maybe [PoolInformation]
a} :: DescribePoolsResponse) 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

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

instance Prelude.NFData DescribePoolsResponse where
  rnf :: DescribePoolsResponse -> ()
rnf DescribePoolsResponse' {Int
Maybe [PoolInformation]
Maybe Text
httpStatus :: Int
pools :: Maybe [PoolInformation]
nextToken :: Maybe Text
$sel:httpStatus:DescribePoolsResponse' :: DescribePoolsResponse -> Int
$sel:pools:DescribePoolsResponse' :: DescribePoolsResponse -> Maybe [PoolInformation]
$sel:nextToken:DescribePoolsResponse' :: DescribePoolsResponse -> Maybe Text
..} =
    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 Maybe [PoolInformation]
pools
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus