{-# 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.GlobalAccelerator.ListCustomRoutingAccelerators
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- List the custom routing accelerators for an Amazon Web Services account.
--
-- This operation returns paginated results.
module Amazonka.GlobalAccelerator.ListCustomRoutingAccelerators
  ( -- * Creating a Request
    ListCustomRoutingAccelerators (..),
    newListCustomRoutingAccelerators,

    -- * Request Lenses
    listCustomRoutingAccelerators_maxResults,
    listCustomRoutingAccelerators_nextToken,

    -- * Destructuring the Response
    ListCustomRoutingAcceleratorsResponse (..),
    newListCustomRoutingAcceleratorsResponse,

    -- * Response Lenses
    listCustomRoutingAcceleratorsResponse_accelerators,
    listCustomRoutingAcceleratorsResponse_nextToken,
    listCustomRoutingAcceleratorsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListCustomRoutingAccelerators' smart constructor.
data ListCustomRoutingAccelerators = ListCustomRoutingAccelerators'
  { -- | The number of custom routing Global Accelerator objects that you want to
    -- return with this call. The default value is 10.
    ListCustomRoutingAccelerators -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next set of results. You receive this token from a
    -- previous call.
    ListCustomRoutingAccelerators -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListCustomRoutingAccelerators
-> ListCustomRoutingAccelerators -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCustomRoutingAccelerators
-> ListCustomRoutingAccelerators -> Bool
$c/= :: ListCustomRoutingAccelerators
-> ListCustomRoutingAccelerators -> Bool
== :: ListCustomRoutingAccelerators
-> ListCustomRoutingAccelerators -> Bool
$c== :: ListCustomRoutingAccelerators
-> ListCustomRoutingAccelerators -> Bool
Prelude.Eq, ReadPrec [ListCustomRoutingAccelerators]
ReadPrec ListCustomRoutingAccelerators
Int -> ReadS ListCustomRoutingAccelerators
ReadS [ListCustomRoutingAccelerators]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCustomRoutingAccelerators]
$creadListPrec :: ReadPrec [ListCustomRoutingAccelerators]
readPrec :: ReadPrec ListCustomRoutingAccelerators
$creadPrec :: ReadPrec ListCustomRoutingAccelerators
readList :: ReadS [ListCustomRoutingAccelerators]
$creadList :: ReadS [ListCustomRoutingAccelerators]
readsPrec :: Int -> ReadS ListCustomRoutingAccelerators
$creadsPrec :: Int -> ReadS ListCustomRoutingAccelerators
Prelude.Read, Int -> ListCustomRoutingAccelerators -> ShowS
[ListCustomRoutingAccelerators] -> ShowS
ListCustomRoutingAccelerators -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCustomRoutingAccelerators] -> ShowS
$cshowList :: [ListCustomRoutingAccelerators] -> ShowS
show :: ListCustomRoutingAccelerators -> String
$cshow :: ListCustomRoutingAccelerators -> String
showsPrec :: Int -> ListCustomRoutingAccelerators -> ShowS
$cshowsPrec :: Int -> ListCustomRoutingAccelerators -> ShowS
Prelude.Show, forall x.
Rep ListCustomRoutingAccelerators x
-> ListCustomRoutingAccelerators
forall x.
ListCustomRoutingAccelerators
-> Rep ListCustomRoutingAccelerators x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCustomRoutingAccelerators x
-> ListCustomRoutingAccelerators
$cfrom :: forall x.
ListCustomRoutingAccelerators
-> Rep ListCustomRoutingAccelerators x
Prelude.Generic)

-- |
-- Create a value of 'ListCustomRoutingAccelerators' 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:
--
-- 'maxResults', 'listCustomRoutingAccelerators_maxResults' - The number of custom routing Global Accelerator objects that you want to
-- return with this call. The default value is 10.
--
-- 'nextToken', 'listCustomRoutingAccelerators_nextToken' - The token for the next set of results. You receive this token from a
-- previous call.
newListCustomRoutingAccelerators ::
  ListCustomRoutingAccelerators
newListCustomRoutingAccelerators :: ListCustomRoutingAccelerators
newListCustomRoutingAccelerators =
  ListCustomRoutingAccelerators'
    { $sel:maxResults:ListCustomRoutingAccelerators' :: Maybe Natural
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCustomRoutingAccelerators' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The number of custom routing Global Accelerator objects that you want to
-- return with this call. The default value is 10.
listCustomRoutingAccelerators_maxResults :: Lens.Lens' ListCustomRoutingAccelerators (Prelude.Maybe Prelude.Natural)
listCustomRoutingAccelerators_maxResults :: Lens' ListCustomRoutingAccelerators (Maybe Natural)
listCustomRoutingAccelerators_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingAccelerators' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListCustomRoutingAccelerators' :: ListCustomRoutingAccelerators -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListCustomRoutingAccelerators
s@ListCustomRoutingAccelerators' {} Maybe Natural
a -> ListCustomRoutingAccelerators
s {$sel:maxResults:ListCustomRoutingAccelerators' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListCustomRoutingAccelerators)

-- | The token for the next set of results. You receive this token from a
-- previous call.
listCustomRoutingAccelerators_nextToken :: Lens.Lens' ListCustomRoutingAccelerators (Prelude.Maybe Prelude.Text)
listCustomRoutingAccelerators_nextToken :: Lens' ListCustomRoutingAccelerators (Maybe Text)
listCustomRoutingAccelerators_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingAccelerators' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCustomRoutingAccelerators' :: ListCustomRoutingAccelerators -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCustomRoutingAccelerators
s@ListCustomRoutingAccelerators' {} Maybe Text
a -> ListCustomRoutingAccelerators
s {$sel:nextToken:ListCustomRoutingAccelerators' :: Maybe Text
nextToken = Maybe Text
a} :: ListCustomRoutingAccelerators)

instance Core.AWSPager ListCustomRoutingAccelerators where
  page :: ListCustomRoutingAccelerators
-> AWSResponse ListCustomRoutingAccelerators
-> Maybe ListCustomRoutingAccelerators
page ListCustomRoutingAccelerators
rq AWSResponse ListCustomRoutingAccelerators
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListCustomRoutingAccelerators
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCustomRoutingAcceleratorsResponse (Maybe Text)
listCustomRoutingAcceleratorsResponse_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 ListCustomRoutingAccelerators
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListCustomRoutingAcceleratorsResponse
  (Maybe [CustomRoutingAccelerator])
listCustomRoutingAcceleratorsResponse_accelerators
            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.$ ListCustomRoutingAccelerators
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListCustomRoutingAccelerators (Maybe Text)
listCustomRoutingAccelerators_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListCustomRoutingAccelerators
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListCustomRoutingAcceleratorsResponse (Maybe Text)
listCustomRoutingAcceleratorsResponse_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
    ListCustomRoutingAccelerators
  where
  type
    AWSResponse ListCustomRoutingAccelerators =
      ListCustomRoutingAcceleratorsResponse
  request :: (Service -> Service)
-> ListCustomRoutingAccelerators
-> Request ListCustomRoutingAccelerators
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 ListCustomRoutingAccelerators
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListCustomRoutingAccelerators)))
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 [CustomRoutingAccelerator]
-> Maybe Text -> Int -> ListCustomRoutingAcceleratorsResponse
ListCustomRoutingAcceleratorsResponse'
            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
"Accelerators" 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
    ListCustomRoutingAccelerators
  where
  hashWithSalt :: Int -> ListCustomRoutingAccelerators -> Int
hashWithSalt Int
_salt ListCustomRoutingAccelerators' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCustomRoutingAccelerators' :: ListCustomRoutingAccelerators -> Maybe Text
$sel:maxResults:ListCustomRoutingAccelerators' :: ListCustomRoutingAccelerators -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListCustomRoutingAccelerators where
  rnf :: ListCustomRoutingAccelerators -> ()
rnf ListCustomRoutingAccelerators' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCustomRoutingAccelerators' :: ListCustomRoutingAccelerators -> Maybe Text
$sel:maxResults:ListCustomRoutingAccelerators' :: ListCustomRoutingAccelerators -> Maybe Natural
..} =
    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

instance Data.ToHeaders ListCustomRoutingAccelerators where
  toHeaders :: ListCustomRoutingAccelerators -> 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
"GlobalAccelerator_V20180706.ListCustomRoutingAccelerators" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListCustomRoutingAccelerators where
  toJSON :: ListCustomRoutingAccelerators -> Value
toJSON ListCustomRoutingAccelerators' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListCustomRoutingAccelerators' :: ListCustomRoutingAccelerators -> Maybe Text
$sel:maxResults:ListCustomRoutingAccelerators' :: ListCustomRoutingAccelerators -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
          ]
      )

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

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

-- | /See:/ 'newListCustomRoutingAcceleratorsResponse' smart constructor.
data ListCustomRoutingAcceleratorsResponse = ListCustomRoutingAcceleratorsResponse'
  { -- | The list of custom routing accelerators for a customer account.
    ListCustomRoutingAcceleratorsResponse
-> Maybe [CustomRoutingAccelerator]
accelerators :: Prelude.Maybe [CustomRoutingAccelerator],
    -- | The token for the next set of results. You receive this token from a
    -- previous call.
    ListCustomRoutingAcceleratorsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListCustomRoutingAcceleratorsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListCustomRoutingAcceleratorsResponse
-> ListCustomRoutingAcceleratorsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListCustomRoutingAcceleratorsResponse
-> ListCustomRoutingAcceleratorsResponse -> Bool
$c/= :: ListCustomRoutingAcceleratorsResponse
-> ListCustomRoutingAcceleratorsResponse -> Bool
== :: ListCustomRoutingAcceleratorsResponse
-> ListCustomRoutingAcceleratorsResponse -> Bool
$c== :: ListCustomRoutingAcceleratorsResponse
-> ListCustomRoutingAcceleratorsResponse -> Bool
Prelude.Eq, ReadPrec [ListCustomRoutingAcceleratorsResponse]
ReadPrec ListCustomRoutingAcceleratorsResponse
Int -> ReadS ListCustomRoutingAcceleratorsResponse
ReadS [ListCustomRoutingAcceleratorsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListCustomRoutingAcceleratorsResponse]
$creadListPrec :: ReadPrec [ListCustomRoutingAcceleratorsResponse]
readPrec :: ReadPrec ListCustomRoutingAcceleratorsResponse
$creadPrec :: ReadPrec ListCustomRoutingAcceleratorsResponse
readList :: ReadS [ListCustomRoutingAcceleratorsResponse]
$creadList :: ReadS [ListCustomRoutingAcceleratorsResponse]
readsPrec :: Int -> ReadS ListCustomRoutingAcceleratorsResponse
$creadsPrec :: Int -> ReadS ListCustomRoutingAcceleratorsResponse
Prelude.Read, Int -> ListCustomRoutingAcceleratorsResponse -> ShowS
[ListCustomRoutingAcceleratorsResponse] -> ShowS
ListCustomRoutingAcceleratorsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListCustomRoutingAcceleratorsResponse] -> ShowS
$cshowList :: [ListCustomRoutingAcceleratorsResponse] -> ShowS
show :: ListCustomRoutingAcceleratorsResponse -> String
$cshow :: ListCustomRoutingAcceleratorsResponse -> String
showsPrec :: Int -> ListCustomRoutingAcceleratorsResponse -> ShowS
$cshowsPrec :: Int -> ListCustomRoutingAcceleratorsResponse -> ShowS
Prelude.Show, forall x.
Rep ListCustomRoutingAcceleratorsResponse x
-> ListCustomRoutingAcceleratorsResponse
forall x.
ListCustomRoutingAcceleratorsResponse
-> Rep ListCustomRoutingAcceleratorsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListCustomRoutingAcceleratorsResponse x
-> ListCustomRoutingAcceleratorsResponse
$cfrom :: forall x.
ListCustomRoutingAcceleratorsResponse
-> Rep ListCustomRoutingAcceleratorsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListCustomRoutingAcceleratorsResponse' 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:
--
-- 'accelerators', 'listCustomRoutingAcceleratorsResponse_accelerators' - The list of custom routing accelerators for a customer account.
--
-- 'nextToken', 'listCustomRoutingAcceleratorsResponse_nextToken' - The token for the next set of results. You receive this token from a
-- previous call.
--
-- 'httpStatus', 'listCustomRoutingAcceleratorsResponse_httpStatus' - The response's http status code.
newListCustomRoutingAcceleratorsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListCustomRoutingAcceleratorsResponse
newListCustomRoutingAcceleratorsResponse :: Int -> ListCustomRoutingAcceleratorsResponse
newListCustomRoutingAcceleratorsResponse Int
pHttpStatus_ =
  ListCustomRoutingAcceleratorsResponse'
    { $sel:accelerators:ListCustomRoutingAcceleratorsResponse' :: Maybe [CustomRoutingAccelerator]
accelerators =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListCustomRoutingAcceleratorsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListCustomRoutingAcceleratorsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of custom routing accelerators for a customer account.
listCustomRoutingAcceleratorsResponse_accelerators :: Lens.Lens' ListCustomRoutingAcceleratorsResponse (Prelude.Maybe [CustomRoutingAccelerator])
listCustomRoutingAcceleratorsResponse_accelerators :: Lens'
  ListCustomRoutingAcceleratorsResponse
  (Maybe [CustomRoutingAccelerator])
listCustomRoutingAcceleratorsResponse_accelerators = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingAcceleratorsResponse' {Maybe [CustomRoutingAccelerator]
accelerators :: Maybe [CustomRoutingAccelerator]
$sel:accelerators:ListCustomRoutingAcceleratorsResponse' :: ListCustomRoutingAcceleratorsResponse
-> Maybe [CustomRoutingAccelerator]
accelerators} -> Maybe [CustomRoutingAccelerator]
accelerators) (\s :: ListCustomRoutingAcceleratorsResponse
s@ListCustomRoutingAcceleratorsResponse' {} Maybe [CustomRoutingAccelerator]
a -> ListCustomRoutingAcceleratorsResponse
s {$sel:accelerators:ListCustomRoutingAcceleratorsResponse' :: Maybe [CustomRoutingAccelerator]
accelerators = Maybe [CustomRoutingAccelerator]
a} :: ListCustomRoutingAcceleratorsResponse) 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 token for the next set of results. You receive this token from a
-- previous call.
listCustomRoutingAcceleratorsResponse_nextToken :: Lens.Lens' ListCustomRoutingAcceleratorsResponse (Prelude.Maybe Prelude.Text)
listCustomRoutingAcceleratorsResponse_nextToken :: Lens' ListCustomRoutingAcceleratorsResponse (Maybe Text)
listCustomRoutingAcceleratorsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListCustomRoutingAcceleratorsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListCustomRoutingAcceleratorsResponse' :: ListCustomRoutingAcceleratorsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListCustomRoutingAcceleratorsResponse
s@ListCustomRoutingAcceleratorsResponse' {} Maybe Text
a -> ListCustomRoutingAcceleratorsResponse
s {$sel:nextToken:ListCustomRoutingAcceleratorsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListCustomRoutingAcceleratorsResponse)

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

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