{-# 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.PinpointEmail.GetDedicatedIps
-- 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 dedicated IP addresses that are associated with your Amazon
-- Pinpoint account.
--
-- This operation returns paginated results.
module Amazonka.PinpointEmail.GetDedicatedIps
  ( -- * Creating a Request
    GetDedicatedIps (..),
    newGetDedicatedIps,

    -- * Request Lenses
    getDedicatedIps_nextToken,
    getDedicatedIps_pageSize,
    getDedicatedIps_poolName,

    -- * Destructuring the Response
    GetDedicatedIpsResponse (..),
    newGetDedicatedIpsResponse,

    -- * Response Lenses
    getDedicatedIpsResponse_dedicatedIps,
    getDedicatedIpsResponse_nextToken,
    getDedicatedIpsResponse_httpStatus,
  )
where

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

-- | A request to obtain more information about dedicated IP pools.
--
-- /See:/ 'newGetDedicatedIps' smart constructor.
data GetDedicatedIps = GetDedicatedIps'
  { -- | A token returned from a previous call to @GetDedicatedIps@ to indicate
    -- the position of the dedicated IP pool in the list of IP pools.
    GetDedicatedIps -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The number of results to show in a single call to
    -- @GetDedicatedIpsRequest@. If the number of results is larger than the
    -- number you specified in this parameter, then the response includes a
    -- @NextToken@ element, which you can use to obtain additional results.
    GetDedicatedIps -> Maybe Int
pageSize :: Prelude.Maybe Prelude.Int,
    -- | The name of the IP pool that the dedicated IP address is associated
    -- with.
    GetDedicatedIps -> Maybe Text
poolName :: Prelude.Maybe Prelude.Text
  }
  deriving (GetDedicatedIps -> GetDedicatedIps -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDedicatedIps -> GetDedicatedIps -> Bool
$c/= :: GetDedicatedIps -> GetDedicatedIps -> Bool
== :: GetDedicatedIps -> GetDedicatedIps -> Bool
$c== :: GetDedicatedIps -> GetDedicatedIps -> Bool
Prelude.Eq, ReadPrec [GetDedicatedIps]
ReadPrec GetDedicatedIps
Int -> ReadS GetDedicatedIps
ReadS [GetDedicatedIps]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDedicatedIps]
$creadListPrec :: ReadPrec [GetDedicatedIps]
readPrec :: ReadPrec GetDedicatedIps
$creadPrec :: ReadPrec GetDedicatedIps
readList :: ReadS [GetDedicatedIps]
$creadList :: ReadS [GetDedicatedIps]
readsPrec :: Int -> ReadS GetDedicatedIps
$creadsPrec :: Int -> ReadS GetDedicatedIps
Prelude.Read, Int -> GetDedicatedIps -> ShowS
[GetDedicatedIps] -> ShowS
GetDedicatedIps -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDedicatedIps] -> ShowS
$cshowList :: [GetDedicatedIps] -> ShowS
show :: GetDedicatedIps -> String
$cshow :: GetDedicatedIps -> String
showsPrec :: Int -> GetDedicatedIps -> ShowS
$cshowsPrec :: Int -> GetDedicatedIps -> ShowS
Prelude.Show, forall x. Rep GetDedicatedIps x -> GetDedicatedIps
forall x. GetDedicatedIps -> Rep GetDedicatedIps x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDedicatedIps x -> GetDedicatedIps
$cfrom :: forall x. GetDedicatedIps -> Rep GetDedicatedIps x
Prelude.Generic)

-- |
-- Create a value of 'GetDedicatedIps' 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', 'getDedicatedIps_nextToken' - A token returned from a previous call to @GetDedicatedIps@ to indicate
-- the position of the dedicated IP pool in the list of IP pools.
--
-- 'pageSize', 'getDedicatedIps_pageSize' - The number of results to show in a single call to
-- @GetDedicatedIpsRequest@. If the number of results is larger than the
-- number you specified in this parameter, then the response includes a
-- @NextToken@ element, which you can use to obtain additional results.
--
-- 'poolName', 'getDedicatedIps_poolName' - The name of the IP pool that the dedicated IP address is associated
-- with.
newGetDedicatedIps ::
  GetDedicatedIps
newGetDedicatedIps :: GetDedicatedIps
newGetDedicatedIps =
  GetDedicatedIps'
    { $sel:nextToken:GetDedicatedIps' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:GetDedicatedIps' :: Maybe Int
pageSize = forall a. Maybe a
Prelude.Nothing,
      $sel:poolName:GetDedicatedIps' :: Maybe Text
poolName = forall a. Maybe a
Prelude.Nothing
    }

-- | A token returned from a previous call to @GetDedicatedIps@ to indicate
-- the position of the dedicated IP pool in the list of IP pools.
getDedicatedIps_nextToken :: Lens.Lens' GetDedicatedIps (Prelude.Maybe Prelude.Text)
getDedicatedIps_nextToken :: Lens' GetDedicatedIps (Maybe Text)
getDedicatedIps_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDedicatedIps' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetDedicatedIps' :: GetDedicatedIps -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetDedicatedIps
s@GetDedicatedIps' {} Maybe Text
a -> GetDedicatedIps
s {$sel:nextToken:GetDedicatedIps' :: Maybe Text
nextToken = Maybe Text
a} :: GetDedicatedIps)

-- | The number of results to show in a single call to
-- @GetDedicatedIpsRequest@. If the number of results is larger than the
-- number you specified in this parameter, then the response includes a
-- @NextToken@ element, which you can use to obtain additional results.
getDedicatedIps_pageSize :: Lens.Lens' GetDedicatedIps (Prelude.Maybe Prelude.Int)
getDedicatedIps_pageSize :: Lens' GetDedicatedIps (Maybe Int)
getDedicatedIps_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDedicatedIps' {Maybe Int
pageSize :: Maybe Int
$sel:pageSize:GetDedicatedIps' :: GetDedicatedIps -> Maybe Int
pageSize} -> Maybe Int
pageSize) (\s :: GetDedicatedIps
s@GetDedicatedIps' {} Maybe Int
a -> GetDedicatedIps
s {$sel:pageSize:GetDedicatedIps' :: Maybe Int
pageSize = Maybe Int
a} :: GetDedicatedIps)

-- | The name of the IP pool that the dedicated IP address is associated
-- with.
getDedicatedIps_poolName :: Lens.Lens' GetDedicatedIps (Prelude.Maybe Prelude.Text)
getDedicatedIps_poolName :: Lens' GetDedicatedIps (Maybe Text)
getDedicatedIps_poolName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDedicatedIps' {Maybe Text
poolName :: Maybe Text
$sel:poolName:GetDedicatedIps' :: GetDedicatedIps -> Maybe Text
poolName} -> Maybe Text
poolName) (\s :: GetDedicatedIps
s@GetDedicatedIps' {} Maybe Text
a -> GetDedicatedIps
s {$sel:poolName:GetDedicatedIps' :: Maybe Text
poolName = Maybe Text
a} :: GetDedicatedIps)

instance Core.AWSPager GetDedicatedIps where
  page :: GetDedicatedIps
-> AWSResponse GetDedicatedIps -> Maybe GetDedicatedIps
page GetDedicatedIps
rq AWSResponse GetDedicatedIps
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetDedicatedIps
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetDedicatedIpsResponse (Maybe Text)
getDedicatedIpsResponse_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 GetDedicatedIps
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetDedicatedIpsResponse (Maybe [DedicatedIp])
getDedicatedIpsResponse_dedicatedIps
            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.$ GetDedicatedIps
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetDedicatedIps (Maybe Text)
getDedicatedIps_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetDedicatedIps
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetDedicatedIpsResponse (Maybe Text)
getDedicatedIpsResponse_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 GetDedicatedIps where
  type
    AWSResponse GetDedicatedIps =
      GetDedicatedIpsResponse
  request :: (Service -> Service) -> GetDedicatedIps -> Request GetDedicatedIps
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 GetDedicatedIps
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetDedicatedIps)))
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 [DedicatedIp] -> Maybe Text -> Int -> GetDedicatedIpsResponse
GetDedicatedIpsResponse'
            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
"DedicatedIps" 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 GetDedicatedIps where
  hashWithSalt :: Int -> GetDedicatedIps -> Int
hashWithSalt Int
_salt GetDedicatedIps' {Maybe Int
Maybe Text
poolName :: Maybe Text
pageSize :: Maybe Int
nextToken :: Maybe Text
$sel:poolName:GetDedicatedIps' :: GetDedicatedIps -> Maybe Text
$sel:pageSize:GetDedicatedIps' :: GetDedicatedIps -> Maybe Int
$sel:nextToken:GetDedicatedIps' :: GetDedicatedIps -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
pageSize
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
poolName

instance Prelude.NFData GetDedicatedIps where
  rnf :: GetDedicatedIps -> ()
rnf GetDedicatedIps' {Maybe Int
Maybe Text
poolName :: Maybe Text
pageSize :: Maybe Int
nextToken :: Maybe Text
$sel:poolName:GetDedicatedIps' :: GetDedicatedIps -> Maybe Text
$sel:pageSize:GetDedicatedIps' :: GetDedicatedIps -> Maybe Int
$sel:nextToken:GetDedicatedIps' :: GetDedicatedIps -> 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 Int
pageSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
poolName

instance Data.ToHeaders GetDedicatedIps where
  toHeaders :: GetDedicatedIps -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath GetDedicatedIps where
  toPath :: GetDedicatedIps -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/email/dedicated-ips"

instance Data.ToQuery GetDedicatedIps where
  toQuery :: GetDedicatedIps -> QueryString
toQuery GetDedicatedIps' {Maybe Int
Maybe Text
poolName :: Maybe Text
pageSize :: Maybe Int
nextToken :: Maybe Text
$sel:poolName:GetDedicatedIps' :: GetDedicatedIps -> Maybe Text
$sel:pageSize:GetDedicatedIps' :: GetDedicatedIps -> Maybe Int
$sel:nextToken:GetDedicatedIps' :: GetDedicatedIps -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"PageSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
pageSize,
        ByteString
"PoolName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
poolName
      ]

-- | Information about the dedicated IP addresses that are associated with
-- your Amazon Pinpoint account.
--
-- /See:/ 'newGetDedicatedIpsResponse' smart constructor.
data GetDedicatedIpsResponse = GetDedicatedIpsResponse'
  { -- | A list of dedicated IP addresses that are reserved for use by your
    -- Amazon Pinpoint account.
    GetDedicatedIpsResponse -> Maybe [DedicatedIp]
dedicatedIps :: Prelude.Maybe [DedicatedIp],
    -- | A token that indicates that there are additional dedicated IP addresses
    -- to list. To view additional addresses, issue another request to
    -- @GetDedicatedIps@, passing this token in the @NextToken@ parameter.
    GetDedicatedIpsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDedicatedIpsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetDedicatedIpsResponse -> GetDedicatedIpsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDedicatedIpsResponse -> GetDedicatedIpsResponse -> Bool
$c/= :: GetDedicatedIpsResponse -> GetDedicatedIpsResponse -> Bool
== :: GetDedicatedIpsResponse -> GetDedicatedIpsResponse -> Bool
$c== :: GetDedicatedIpsResponse -> GetDedicatedIpsResponse -> Bool
Prelude.Eq, ReadPrec [GetDedicatedIpsResponse]
ReadPrec GetDedicatedIpsResponse
Int -> ReadS GetDedicatedIpsResponse
ReadS [GetDedicatedIpsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDedicatedIpsResponse]
$creadListPrec :: ReadPrec [GetDedicatedIpsResponse]
readPrec :: ReadPrec GetDedicatedIpsResponse
$creadPrec :: ReadPrec GetDedicatedIpsResponse
readList :: ReadS [GetDedicatedIpsResponse]
$creadList :: ReadS [GetDedicatedIpsResponse]
readsPrec :: Int -> ReadS GetDedicatedIpsResponse
$creadsPrec :: Int -> ReadS GetDedicatedIpsResponse
Prelude.Read, Int -> GetDedicatedIpsResponse -> ShowS
[GetDedicatedIpsResponse] -> ShowS
GetDedicatedIpsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDedicatedIpsResponse] -> ShowS
$cshowList :: [GetDedicatedIpsResponse] -> ShowS
show :: GetDedicatedIpsResponse -> String
$cshow :: GetDedicatedIpsResponse -> String
showsPrec :: Int -> GetDedicatedIpsResponse -> ShowS
$cshowsPrec :: Int -> GetDedicatedIpsResponse -> ShowS
Prelude.Show, forall x. Rep GetDedicatedIpsResponse x -> GetDedicatedIpsResponse
forall x. GetDedicatedIpsResponse -> Rep GetDedicatedIpsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetDedicatedIpsResponse x -> GetDedicatedIpsResponse
$cfrom :: forall x. GetDedicatedIpsResponse -> Rep GetDedicatedIpsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDedicatedIpsResponse' 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:
--
-- 'dedicatedIps', 'getDedicatedIpsResponse_dedicatedIps' - A list of dedicated IP addresses that are reserved for use by your
-- Amazon Pinpoint account.
--
-- 'nextToken', 'getDedicatedIpsResponse_nextToken' - A token that indicates that there are additional dedicated IP addresses
-- to list. To view additional addresses, issue another request to
-- @GetDedicatedIps@, passing this token in the @NextToken@ parameter.
--
-- 'httpStatus', 'getDedicatedIpsResponse_httpStatus' - The response's http status code.
newGetDedicatedIpsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDedicatedIpsResponse
newGetDedicatedIpsResponse :: Int -> GetDedicatedIpsResponse
newGetDedicatedIpsResponse Int
pHttpStatus_ =
  GetDedicatedIpsResponse'
    { $sel:dedicatedIps:GetDedicatedIpsResponse' :: Maybe [DedicatedIp]
dedicatedIps =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetDedicatedIpsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDedicatedIpsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of dedicated IP addresses that are reserved for use by your
-- Amazon Pinpoint account.
getDedicatedIpsResponse_dedicatedIps :: Lens.Lens' GetDedicatedIpsResponse (Prelude.Maybe [DedicatedIp])
getDedicatedIpsResponse_dedicatedIps :: Lens' GetDedicatedIpsResponse (Maybe [DedicatedIp])
getDedicatedIpsResponse_dedicatedIps = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDedicatedIpsResponse' {Maybe [DedicatedIp]
dedicatedIps :: Maybe [DedicatedIp]
$sel:dedicatedIps:GetDedicatedIpsResponse' :: GetDedicatedIpsResponse -> Maybe [DedicatedIp]
dedicatedIps} -> Maybe [DedicatedIp]
dedicatedIps) (\s :: GetDedicatedIpsResponse
s@GetDedicatedIpsResponse' {} Maybe [DedicatedIp]
a -> GetDedicatedIpsResponse
s {$sel:dedicatedIps:GetDedicatedIpsResponse' :: Maybe [DedicatedIp]
dedicatedIps = Maybe [DedicatedIp]
a} :: GetDedicatedIpsResponse) 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

-- | A token that indicates that there are additional dedicated IP addresses
-- to list. To view additional addresses, issue another request to
-- @GetDedicatedIps@, passing this token in the @NextToken@ parameter.
getDedicatedIpsResponse_nextToken :: Lens.Lens' GetDedicatedIpsResponse (Prelude.Maybe Prelude.Text)
getDedicatedIpsResponse_nextToken :: Lens' GetDedicatedIpsResponse (Maybe Text)
getDedicatedIpsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDedicatedIpsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetDedicatedIpsResponse' :: GetDedicatedIpsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetDedicatedIpsResponse
s@GetDedicatedIpsResponse' {} Maybe Text
a -> GetDedicatedIpsResponse
s {$sel:nextToken:GetDedicatedIpsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetDedicatedIpsResponse)

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

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