{-# 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.Route53.ListCidrBlocks
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a paginated list of location objects and their CIDR blocks.
--
-- This operation returns paginated results.
module Amazonka.Route53.ListCidrBlocks
  ( -- * Creating a Request
    ListCidrBlocks (..),
    newListCidrBlocks,

    -- * Request Lenses
    listCidrBlocks_locationName,
    listCidrBlocks_maxResults,
    listCidrBlocks_nextToken,
    listCidrBlocks_collectionId,

    -- * Destructuring the Response
    ListCidrBlocksResponse (..),
    newListCidrBlocksResponse,

    -- * Response Lenses
    listCidrBlocksResponse_cidrBlocks,
    listCidrBlocksResponse_nextToken,
    listCidrBlocksResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.Route53.Types

-- | /See:/ 'newListCidrBlocks' smart constructor.
data ListCidrBlocks = ListCidrBlocks'
  { -- | The name of the CIDR collection location.
    ListCidrBlocks -> Maybe Text
locationName :: Prelude.Maybe Prelude.Text,
    -- | Maximum number of results you want returned.
    ListCidrBlocks -> Maybe Text
maxResults :: Prelude.Maybe Prelude.Text,
    -- | An opaque pagination token to indicate where the service is to begin
    -- enumerating results.
    ListCidrBlocks -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The UUID of the CIDR collection.
    ListCidrBlocks -> Text
collectionId :: Prelude.Text
  }
  deriving (ListCidrBlocks -> ListCidrBlocks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCidrBlocks -> ListCidrBlocks -> Bool
$c/= :: ListCidrBlocks -> ListCidrBlocks -> Bool
== :: ListCidrBlocks -> ListCidrBlocks -> Bool
$c== :: ListCidrBlocks -> ListCidrBlocks -> Bool
Prelude.Eq, ReadPrec [ListCidrBlocks]
ReadPrec ListCidrBlocks
Int -> ReadS ListCidrBlocks
ReadS [ListCidrBlocks]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCidrBlocks]
$creadListPrec :: ReadPrec [ListCidrBlocks]
readPrec :: ReadPrec ListCidrBlocks
$creadPrec :: ReadPrec ListCidrBlocks
readList :: ReadS [ListCidrBlocks]
$creadList :: ReadS [ListCidrBlocks]
readsPrec :: Int -> ReadS ListCidrBlocks
$creadsPrec :: Int -> ReadS ListCidrBlocks
Prelude.Read, Int -> ListCidrBlocks -> ShowS
[ListCidrBlocks] -> ShowS
ListCidrBlocks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCidrBlocks] -> ShowS
$cshowList :: [ListCidrBlocks] -> ShowS
show :: ListCidrBlocks -> String
$cshow :: ListCidrBlocks -> String
showsPrec :: Int -> ListCidrBlocks -> ShowS
$cshowsPrec :: Int -> ListCidrBlocks -> ShowS
Prelude.Show, forall x. Rep ListCidrBlocks x -> ListCidrBlocks
forall x. ListCidrBlocks -> Rep ListCidrBlocks x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCidrBlocks x -> ListCidrBlocks
$cfrom :: forall x. ListCidrBlocks -> Rep ListCidrBlocks x
Prelude.Generic)

-- |
-- Create a value of 'ListCidrBlocks' 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:
--
-- 'locationName', 'listCidrBlocks_locationName' - The name of the CIDR collection location.
--
-- 'maxResults', 'listCidrBlocks_maxResults' - Maximum number of results you want returned.
--
-- 'nextToken', 'listCidrBlocks_nextToken' - An opaque pagination token to indicate where the service is to begin
-- enumerating results.
--
-- 'collectionId', 'listCidrBlocks_collectionId' - The UUID of the CIDR collection.
newListCidrBlocks ::
  -- | 'collectionId'
  Prelude.Text ->
  ListCidrBlocks
newListCidrBlocks :: Text -> ListCidrBlocks
newListCidrBlocks Text
pCollectionId_ =
  ListCidrBlocks'
    { $sel:locationName:ListCidrBlocks' :: Maybe Text
locationName = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListCidrBlocks' :: Maybe Text
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCidrBlocks' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:collectionId:ListCidrBlocks' :: Text
collectionId = Text
pCollectionId_
    }

-- | The name of the CIDR collection location.
listCidrBlocks_locationName :: Lens.Lens' ListCidrBlocks (Prelude.Maybe Prelude.Text)
listCidrBlocks_locationName :: Lens' ListCidrBlocks (Maybe Text)
listCidrBlocks_locationName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCidrBlocks' {Maybe Text
locationName :: Maybe Text
$sel:locationName:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
locationName} -> Maybe Text
locationName) (\s :: ListCidrBlocks
s@ListCidrBlocks' {} Maybe Text
a -> ListCidrBlocks
s {$sel:locationName:ListCidrBlocks' :: Maybe Text
locationName = Maybe Text
a} :: ListCidrBlocks)

-- | Maximum number of results you want returned.
listCidrBlocks_maxResults :: Lens.Lens' ListCidrBlocks (Prelude.Maybe Prelude.Text)
listCidrBlocks_maxResults :: Lens' ListCidrBlocks (Maybe Text)
listCidrBlocks_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCidrBlocks' {Maybe Text
maxResults :: Maybe Text
$sel:maxResults:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
maxResults} -> Maybe Text
maxResults) (\s :: ListCidrBlocks
s@ListCidrBlocks' {} Maybe Text
a -> ListCidrBlocks
s {$sel:maxResults:ListCidrBlocks' :: Maybe Text
maxResults = Maybe Text
a} :: ListCidrBlocks)

-- | An opaque pagination token to indicate where the service is to begin
-- enumerating results.
listCidrBlocks_nextToken :: Lens.Lens' ListCidrBlocks (Prelude.Maybe Prelude.Text)
listCidrBlocks_nextToken :: Lens' ListCidrBlocks (Maybe Text)
listCidrBlocks_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCidrBlocks' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCidrBlocks
s@ListCidrBlocks' {} Maybe Text
a -> ListCidrBlocks
s {$sel:nextToken:ListCidrBlocks' :: Maybe Text
nextToken = Maybe Text
a} :: ListCidrBlocks)

-- | The UUID of the CIDR collection.
listCidrBlocks_collectionId :: Lens.Lens' ListCidrBlocks Prelude.Text
listCidrBlocks_collectionId :: Lens' ListCidrBlocks Text
listCidrBlocks_collectionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCidrBlocks' {Text
collectionId :: Text
$sel:collectionId:ListCidrBlocks' :: ListCidrBlocks -> Text
collectionId} -> Text
collectionId) (\s :: ListCidrBlocks
s@ListCidrBlocks' {} Text
a -> ListCidrBlocks
s {$sel:collectionId:ListCidrBlocks' :: Text
collectionId = Text
a} :: ListCidrBlocks)

instance Core.AWSPager ListCidrBlocks where
  page :: ListCidrBlocks
-> AWSResponse ListCidrBlocks -> Maybe ListCidrBlocks
page ListCidrBlocks
rq AWSResponse ListCidrBlocks
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCidrBlocks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCidrBlocksResponse (Maybe Text)
listCidrBlocksResponse_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 ListCidrBlocks
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCidrBlocksResponse (Maybe [CidrBlockSummary])
listCidrBlocksResponse_cidrBlocks
            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.$ ListCidrBlocks
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCidrBlocks (Maybe Text)
listCidrBlocks_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCidrBlocks
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCidrBlocksResponse (Maybe Text)
listCidrBlocksResponse_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 ListCidrBlocks where
  type
    AWSResponse ListCidrBlocks =
      ListCidrBlocksResponse
  request :: (Service -> Service) -> ListCidrBlocks -> Request ListCidrBlocks
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListCidrBlocks
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListCidrBlocks)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [CidrBlockSummary]
-> Maybe Text -> Int -> ListCidrBlocksResponse
ListCidrBlocksResponse'
            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
"CidrBlocks"
                            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
"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 ListCidrBlocks where
  hashWithSalt :: Int -> ListCidrBlocks -> Int
hashWithSalt Int
_salt ListCidrBlocks' {Maybe Text
Text
collectionId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Text
locationName :: Maybe Text
$sel:collectionId:ListCidrBlocks' :: ListCidrBlocks -> Text
$sel:nextToken:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
$sel:maxResults:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
$sel:locationName:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
locationName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionId

instance Prelude.NFData ListCidrBlocks where
  rnf :: ListCidrBlocks -> ()
rnf ListCidrBlocks' {Maybe Text
Text
collectionId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Text
locationName :: Maybe Text
$sel:collectionId:ListCidrBlocks' :: ListCidrBlocks -> Text
$sel:nextToken:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
$sel:maxResults:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
$sel:locationName:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
locationName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
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 Text
collectionId

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

instance Data.ToPath ListCidrBlocks where
  toPath :: ListCidrBlocks -> ByteString
toPath ListCidrBlocks' {Maybe Text
Text
collectionId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Text
locationName :: Maybe Text
$sel:collectionId:ListCidrBlocks' :: ListCidrBlocks -> Text
$sel:nextToken:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
$sel:maxResults:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
$sel:locationName:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2013-04-01/cidrcollection/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
collectionId,
        ByteString
"/cidrblocks"
      ]

instance Data.ToQuery ListCidrBlocks where
  toQuery :: ListCidrBlocks -> QueryString
toQuery ListCidrBlocks' {Maybe Text
Text
collectionId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Text
locationName :: Maybe Text
$sel:collectionId:ListCidrBlocks' :: ListCidrBlocks -> Text
$sel:nextToken:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
$sel:maxResults:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
$sel:locationName:ListCidrBlocks' :: ListCidrBlocks -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"location" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
locationName,
        ByteString
"maxresults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
maxResults,
        ByteString
"nexttoken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newListCidrBlocksResponse' smart constructor.
data ListCidrBlocksResponse = ListCidrBlocksResponse'
  { -- | A complex type that contains information about the CIDR blocks.
    ListCidrBlocksResponse -> Maybe [CidrBlockSummary]
cidrBlocks :: Prelude.Maybe [CidrBlockSummary],
    -- | An opaque pagination token to indicate where the service is to begin
    -- enumerating results.
    --
    -- If no value is provided, the listing of results starts from the
    -- beginning.
    ListCidrBlocksResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCidrBlocksResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCidrBlocksResponse -> ListCidrBlocksResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCidrBlocksResponse -> ListCidrBlocksResponse -> Bool
$c/= :: ListCidrBlocksResponse -> ListCidrBlocksResponse -> Bool
== :: ListCidrBlocksResponse -> ListCidrBlocksResponse -> Bool
$c== :: ListCidrBlocksResponse -> ListCidrBlocksResponse -> Bool
Prelude.Eq, ReadPrec [ListCidrBlocksResponse]
ReadPrec ListCidrBlocksResponse
Int -> ReadS ListCidrBlocksResponse
ReadS [ListCidrBlocksResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCidrBlocksResponse]
$creadListPrec :: ReadPrec [ListCidrBlocksResponse]
readPrec :: ReadPrec ListCidrBlocksResponse
$creadPrec :: ReadPrec ListCidrBlocksResponse
readList :: ReadS [ListCidrBlocksResponse]
$creadList :: ReadS [ListCidrBlocksResponse]
readsPrec :: Int -> ReadS ListCidrBlocksResponse
$creadsPrec :: Int -> ReadS ListCidrBlocksResponse
Prelude.Read, Int -> ListCidrBlocksResponse -> ShowS
[ListCidrBlocksResponse] -> ShowS
ListCidrBlocksResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCidrBlocksResponse] -> ShowS
$cshowList :: [ListCidrBlocksResponse] -> ShowS
show :: ListCidrBlocksResponse -> String
$cshow :: ListCidrBlocksResponse -> String
showsPrec :: Int -> ListCidrBlocksResponse -> ShowS
$cshowsPrec :: Int -> ListCidrBlocksResponse -> ShowS
Prelude.Show, forall x. Rep ListCidrBlocksResponse x -> ListCidrBlocksResponse
forall x. ListCidrBlocksResponse -> Rep ListCidrBlocksResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListCidrBlocksResponse x -> ListCidrBlocksResponse
$cfrom :: forall x. ListCidrBlocksResponse -> Rep ListCidrBlocksResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCidrBlocksResponse' 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:
--
-- 'cidrBlocks', 'listCidrBlocksResponse_cidrBlocks' - A complex type that contains information about the CIDR blocks.
--
-- 'nextToken', 'listCidrBlocksResponse_nextToken' - An opaque pagination token to indicate where the service is to begin
-- enumerating results.
--
-- If no value is provided, the listing of results starts from the
-- beginning.
--
-- 'httpStatus', 'listCidrBlocksResponse_httpStatus' - The response's http status code.
newListCidrBlocksResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCidrBlocksResponse
newListCidrBlocksResponse :: Int -> ListCidrBlocksResponse
newListCidrBlocksResponse Int
pHttpStatus_ =
  ListCidrBlocksResponse'
    { $sel:cidrBlocks:ListCidrBlocksResponse' :: Maybe [CidrBlockSummary]
cidrBlocks =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCidrBlocksResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCidrBlocksResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A complex type that contains information about the CIDR blocks.
listCidrBlocksResponse_cidrBlocks :: Lens.Lens' ListCidrBlocksResponse (Prelude.Maybe [CidrBlockSummary])
listCidrBlocksResponse_cidrBlocks :: Lens' ListCidrBlocksResponse (Maybe [CidrBlockSummary])
listCidrBlocksResponse_cidrBlocks = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCidrBlocksResponse' {Maybe [CidrBlockSummary]
cidrBlocks :: Maybe [CidrBlockSummary]
$sel:cidrBlocks:ListCidrBlocksResponse' :: ListCidrBlocksResponse -> Maybe [CidrBlockSummary]
cidrBlocks} -> Maybe [CidrBlockSummary]
cidrBlocks) (\s :: ListCidrBlocksResponse
s@ListCidrBlocksResponse' {} Maybe [CidrBlockSummary]
a -> ListCidrBlocksResponse
s {$sel:cidrBlocks:ListCidrBlocksResponse' :: Maybe [CidrBlockSummary]
cidrBlocks = Maybe [CidrBlockSummary]
a} :: ListCidrBlocksResponse) 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 opaque pagination token to indicate where the service is to begin
-- enumerating results.
--
-- If no value is provided, the listing of results starts from the
-- beginning.
listCidrBlocksResponse_nextToken :: Lens.Lens' ListCidrBlocksResponse (Prelude.Maybe Prelude.Text)
listCidrBlocksResponse_nextToken :: Lens' ListCidrBlocksResponse (Maybe Text)
listCidrBlocksResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCidrBlocksResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCidrBlocksResponse' :: ListCidrBlocksResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCidrBlocksResponse
s@ListCidrBlocksResponse' {} Maybe Text
a -> ListCidrBlocksResponse
s {$sel:nextToken:ListCidrBlocksResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCidrBlocksResponse)

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

instance Prelude.NFData ListCidrBlocksResponse where
  rnf :: ListCidrBlocksResponse -> ()
rnf ListCidrBlocksResponse' {Int
Maybe [CidrBlockSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
cidrBlocks :: Maybe [CidrBlockSummary]
$sel:httpStatus:ListCidrBlocksResponse' :: ListCidrBlocksResponse -> Int
$sel:nextToken:ListCidrBlocksResponse' :: ListCidrBlocksResponse -> Maybe Text
$sel:cidrBlocks:ListCidrBlocksResponse' :: ListCidrBlocksResponse -> Maybe [CidrBlockSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [CidrBlockSummary]
cidrBlocks
      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