{-# 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.Route53Domains.ListPrices
-- 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 the following prices for either all the TLDs supported by
-- Route 53, or the specified TLD:
--
-- -   Registration
--
-- -   Transfer
--
-- -   Owner change
--
-- -   Domain renewal
--
-- -   Domain restoration
--
-- This operation returns paginated results.
module Amazonka.Route53Domains.ListPrices
  ( -- * Creating a Request
    ListPrices (..),
    newListPrices,

    -- * Request Lenses
    listPrices_marker,
    listPrices_maxItems,
    listPrices_tld,

    -- * Destructuring the Response
    ListPricesResponse (..),
    newListPricesResponse,

    -- * Response Lenses
    listPricesResponse_nextPageMarker,
    listPricesResponse_prices,
    listPricesResponse_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.Route53Domains.Types

-- | /See:/ 'newListPrices' smart constructor.
data ListPrices = ListPrices'
  { -- | For an initial request for a list of prices, omit this element. If the
    -- number of prices that are not yet complete is greater than the value
    -- that you specified for @MaxItems@, you can use @Marker@ to return
    -- additional prices. Get the value of @NextPageMarker@ from the previous
    -- response, and submit another request that includes the value of
    -- @NextPageMarker@ in the @Marker@ element.
    --
    -- Used only for all TLDs. If you specify a TLD, don\'t specify a @Marker@.
    ListPrices -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | Number of @Prices@ to be returned.
    --
    -- Used only for all TLDs. If you specify a TLD, don\'t specify a
    -- @MaxItems@.
    ListPrices -> Maybe Int
maxItems :: Prelude.Maybe Prelude.Int,
    -- | The TLD for which you want to receive the pricing information. For
    -- example. @.net@.
    --
    -- If a @Tld@ value is not provided, a list of prices for all TLDs
    -- supported by Route 53 is returned.
    ListPrices -> Maybe Text
tld :: Prelude.Maybe Prelude.Text
  }
  deriving (ListPrices -> ListPrices -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPrices -> ListPrices -> Bool
$c/= :: ListPrices -> ListPrices -> Bool
== :: ListPrices -> ListPrices -> Bool
$c== :: ListPrices -> ListPrices -> Bool
Prelude.Eq, ReadPrec [ListPrices]
ReadPrec ListPrices
Int -> ReadS ListPrices
ReadS [ListPrices]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPrices]
$creadListPrec :: ReadPrec [ListPrices]
readPrec :: ReadPrec ListPrices
$creadPrec :: ReadPrec ListPrices
readList :: ReadS [ListPrices]
$creadList :: ReadS [ListPrices]
readsPrec :: Int -> ReadS ListPrices
$creadsPrec :: Int -> ReadS ListPrices
Prelude.Read, Int -> ListPrices -> ShowS
[ListPrices] -> ShowS
ListPrices -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPrices] -> ShowS
$cshowList :: [ListPrices] -> ShowS
show :: ListPrices -> String
$cshow :: ListPrices -> String
showsPrec :: Int -> ListPrices -> ShowS
$cshowsPrec :: Int -> ListPrices -> ShowS
Prelude.Show, forall x. Rep ListPrices x -> ListPrices
forall x. ListPrices -> Rep ListPrices x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPrices x -> ListPrices
$cfrom :: forall x. ListPrices -> Rep ListPrices x
Prelude.Generic)

-- |
-- Create a value of 'ListPrices' 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:
--
-- 'marker', 'listPrices_marker' - For an initial request for a list of prices, omit this element. If the
-- number of prices that are not yet complete is greater than the value
-- that you specified for @MaxItems@, you can use @Marker@ to return
-- additional prices. Get the value of @NextPageMarker@ from the previous
-- response, and submit another request that includes the value of
-- @NextPageMarker@ in the @Marker@ element.
--
-- Used only for all TLDs. If you specify a TLD, don\'t specify a @Marker@.
--
-- 'maxItems', 'listPrices_maxItems' - Number of @Prices@ to be returned.
--
-- Used only for all TLDs. If you specify a TLD, don\'t specify a
-- @MaxItems@.
--
-- 'tld', 'listPrices_tld' - The TLD for which you want to receive the pricing information. For
-- example. @.net@.
--
-- If a @Tld@ value is not provided, a list of prices for all TLDs
-- supported by Route 53 is returned.
newListPrices ::
  ListPrices
newListPrices :: ListPrices
newListPrices =
  ListPrices'
    { $sel:marker:ListPrices' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListPrices' :: Maybe Int
maxItems = forall a. Maybe a
Prelude.Nothing,
      $sel:tld:ListPrices' :: Maybe Text
tld = forall a. Maybe a
Prelude.Nothing
    }

-- | For an initial request for a list of prices, omit this element. If the
-- number of prices that are not yet complete is greater than the value
-- that you specified for @MaxItems@, you can use @Marker@ to return
-- additional prices. Get the value of @NextPageMarker@ from the previous
-- response, and submit another request that includes the value of
-- @NextPageMarker@ in the @Marker@ element.
--
-- Used only for all TLDs. If you specify a TLD, don\'t specify a @Marker@.
listPrices_marker :: Lens.Lens' ListPrices (Prelude.Maybe Prelude.Text)
listPrices_marker :: Lens' ListPrices (Maybe Text)
listPrices_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPrices' {Maybe Text
marker :: Maybe Text
$sel:marker:ListPrices' :: ListPrices -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListPrices
s@ListPrices' {} Maybe Text
a -> ListPrices
s {$sel:marker:ListPrices' :: Maybe Text
marker = Maybe Text
a} :: ListPrices)

-- | Number of @Prices@ to be returned.
--
-- Used only for all TLDs. If you specify a TLD, don\'t specify a
-- @MaxItems@.
listPrices_maxItems :: Lens.Lens' ListPrices (Prelude.Maybe Prelude.Int)
listPrices_maxItems :: Lens' ListPrices (Maybe Int)
listPrices_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPrices' {Maybe Int
maxItems :: Maybe Int
$sel:maxItems:ListPrices' :: ListPrices -> Maybe Int
maxItems} -> Maybe Int
maxItems) (\s :: ListPrices
s@ListPrices' {} Maybe Int
a -> ListPrices
s {$sel:maxItems:ListPrices' :: Maybe Int
maxItems = Maybe Int
a} :: ListPrices)

-- | The TLD for which you want to receive the pricing information. For
-- example. @.net@.
--
-- If a @Tld@ value is not provided, a list of prices for all TLDs
-- supported by Route 53 is returned.
listPrices_tld :: Lens.Lens' ListPrices (Prelude.Maybe Prelude.Text)
listPrices_tld :: Lens' ListPrices (Maybe Text)
listPrices_tld = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPrices' {Maybe Text
tld :: Maybe Text
$sel:tld:ListPrices' :: ListPrices -> Maybe Text
tld} -> Maybe Text
tld) (\s :: ListPrices
s@ListPrices' {} Maybe Text
a -> ListPrices
s {$sel:tld:ListPrices' :: Maybe Text
tld = Maybe Text
a} :: ListPrices)

instance Core.AWSPager ListPrices where
  page :: ListPrices -> AWSResponse ListPrices -> Maybe ListPrices
page ListPrices
rq AWSResponse ListPrices
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPrices
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPricesResponse (Maybe Text)
listPricesResponse_nextPageMarker
            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 ListPrices
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPricesResponse (Maybe [DomainPrice])
listPricesResponse_prices
            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.$ ListPrices
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListPrices (Maybe Text)
listPrices_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListPrices
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPricesResponse (Maybe Text)
listPricesResponse_nextPageMarker
          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 ListPrices where
  type AWSResponse ListPrices = ListPricesResponse
  request :: (Service -> Service) -> ListPrices -> Request ListPrices
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 ListPrices
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListPrices)))
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 [DomainPrice] -> Int -> ListPricesResponse
ListPricesResponse'
            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
"NextPageMarker")
            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
"Prices" 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 ListPrices where
  hashWithSalt :: Int -> ListPrices -> Int
hashWithSalt Int
_salt ListPrices' {Maybe Int
Maybe Text
tld :: Maybe Text
maxItems :: Maybe Int
marker :: Maybe Text
$sel:tld:ListPrices' :: ListPrices -> Maybe Text
$sel:maxItems:ListPrices' :: ListPrices -> Maybe Int
$sel:marker:ListPrices' :: ListPrices -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxItems
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
tld

instance Prelude.NFData ListPrices where
  rnf :: ListPrices -> ()
rnf ListPrices' {Maybe Int
Maybe Text
tld :: Maybe Text
maxItems :: Maybe Int
marker :: Maybe Text
$sel:tld:ListPrices' :: ListPrices -> Maybe Text
$sel:maxItems:ListPrices' :: ListPrices -> Maybe Int
$sel:marker:ListPrices' :: ListPrices -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxItems
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
tld

instance Data.ToHeaders ListPrices where
  toHeaders :: ListPrices -> 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
"Route53Domains_v20140515.ListPrices" ::
                          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 ListPrices where
  toJSON :: ListPrices -> Value
toJSON ListPrices' {Maybe Int
Maybe Text
tld :: Maybe Text
maxItems :: Maybe Int
marker :: Maybe Text
$sel:tld:ListPrices' :: ListPrices -> Maybe Text
$sel:maxItems:ListPrices' :: ListPrices -> Maybe Int
$sel:marker:ListPrices' :: ListPrices -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Marker" 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
marker,
            (Key
"MaxItems" 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
maxItems,
            (Key
"Tld" 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
tld
          ]
      )

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

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

-- | /See:/ 'newListPricesResponse' smart constructor.
data ListPricesResponse = ListPricesResponse'
  { -- | If there are more prices than you specified for @MaxItems@ in the
    -- request, submit another request and include the value of
    -- @NextPageMarker@ in the value of @Marker@.
    --
    -- Used only for all TLDs. If you specify a TLD, don\'t specify a
    -- @NextPageMarker@.
    ListPricesResponse -> Maybe Text
nextPageMarker :: Prelude.Maybe Prelude.Text,
    -- | A complex type that includes all the pricing information. If you specify
    -- a TLD, this array contains only the pricing for that TLD.
    ListPricesResponse -> Maybe [DomainPrice]
prices :: Prelude.Maybe [DomainPrice],
    -- | The response's http status code.
    ListPricesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPricesResponse -> ListPricesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPricesResponse -> ListPricesResponse -> Bool
$c/= :: ListPricesResponse -> ListPricesResponse -> Bool
== :: ListPricesResponse -> ListPricesResponse -> Bool
$c== :: ListPricesResponse -> ListPricesResponse -> Bool
Prelude.Eq, ReadPrec [ListPricesResponse]
ReadPrec ListPricesResponse
Int -> ReadS ListPricesResponse
ReadS [ListPricesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPricesResponse]
$creadListPrec :: ReadPrec [ListPricesResponse]
readPrec :: ReadPrec ListPricesResponse
$creadPrec :: ReadPrec ListPricesResponse
readList :: ReadS [ListPricesResponse]
$creadList :: ReadS [ListPricesResponse]
readsPrec :: Int -> ReadS ListPricesResponse
$creadsPrec :: Int -> ReadS ListPricesResponse
Prelude.Read, Int -> ListPricesResponse -> ShowS
[ListPricesResponse] -> ShowS
ListPricesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPricesResponse] -> ShowS
$cshowList :: [ListPricesResponse] -> ShowS
show :: ListPricesResponse -> String
$cshow :: ListPricesResponse -> String
showsPrec :: Int -> ListPricesResponse -> ShowS
$cshowsPrec :: Int -> ListPricesResponse -> ShowS
Prelude.Show, forall x. Rep ListPricesResponse x -> ListPricesResponse
forall x. ListPricesResponse -> Rep ListPricesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPricesResponse x -> ListPricesResponse
$cfrom :: forall x. ListPricesResponse -> Rep ListPricesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPricesResponse' 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:
--
-- 'nextPageMarker', 'listPricesResponse_nextPageMarker' - If there are more prices than you specified for @MaxItems@ in the
-- request, submit another request and include the value of
-- @NextPageMarker@ in the value of @Marker@.
--
-- Used only for all TLDs. If you specify a TLD, don\'t specify a
-- @NextPageMarker@.
--
-- 'prices', 'listPricesResponse_prices' - A complex type that includes all the pricing information. If you specify
-- a TLD, this array contains only the pricing for that TLD.
--
-- 'httpStatus', 'listPricesResponse_httpStatus' - The response's http status code.
newListPricesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPricesResponse
newListPricesResponse :: Int -> ListPricesResponse
newListPricesResponse Int
pHttpStatus_ =
  ListPricesResponse'
    { $sel:nextPageMarker:ListPricesResponse' :: Maybe Text
nextPageMarker =
        forall a. Maybe a
Prelude.Nothing,
      $sel:prices:ListPricesResponse' :: Maybe [DomainPrice]
prices = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPricesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If there are more prices than you specified for @MaxItems@ in the
-- request, submit another request and include the value of
-- @NextPageMarker@ in the value of @Marker@.
--
-- Used only for all TLDs. If you specify a TLD, don\'t specify a
-- @NextPageMarker@.
listPricesResponse_nextPageMarker :: Lens.Lens' ListPricesResponse (Prelude.Maybe Prelude.Text)
listPricesResponse_nextPageMarker :: Lens' ListPricesResponse (Maybe Text)
listPricesResponse_nextPageMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricesResponse' {Maybe Text
nextPageMarker :: Maybe Text
$sel:nextPageMarker:ListPricesResponse' :: ListPricesResponse -> Maybe Text
nextPageMarker} -> Maybe Text
nextPageMarker) (\s :: ListPricesResponse
s@ListPricesResponse' {} Maybe Text
a -> ListPricesResponse
s {$sel:nextPageMarker:ListPricesResponse' :: Maybe Text
nextPageMarker = Maybe Text
a} :: ListPricesResponse)

-- | A complex type that includes all the pricing information. If you specify
-- a TLD, this array contains only the pricing for that TLD.
listPricesResponse_prices :: Lens.Lens' ListPricesResponse (Prelude.Maybe [DomainPrice])
listPricesResponse_prices :: Lens' ListPricesResponse (Maybe [DomainPrice])
listPricesResponse_prices = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricesResponse' {Maybe [DomainPrice]
prices :: Maybe [DomainPrice]
$sel:prices:ListPricesResponse' :: ListPricesResponse -> Maybe [DomainPrice]
prices} -> Maybe [DomainPrice]
prices) (\s :: ListPricesResponse
s@ListPricesResponse' {} Maybe [DomainPrice]
a -> ListPricesResponse
s {$sel:prices:ListPricesResponse' :: Maybe [DomainPrice]
prices = Maybe [DomainPrice]
a} :: ListPricesResponse) 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.
listPricesResponse_httpStatus :: Lens.Lens' ListPricesResponse Prelude.Int
listPricesResponse_httpStatus :: Lens' ListPricesResponse Int
listPricesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListPricesResponse' :: ListPricesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListPricesResponse
s@ListPricesResponse' {} Int
a -> ListPricesResponse
s {$sel:httpStatus:ListPricesResponse' :: Int
httpStatus = Int
a} :: ListPricesResponse)

instance Prelude.NFData ListPricesResponse where
  rnf :: ListPricesResponse -> ()
rnf ListPricesResponse' {Int
Maybe [DomainPrice]
Maybe Text
httpStatus :: Int
prices :: Maybe [DomainPrice]
nextPageMarker :: Maybe Text
$sel:httpStatus:ListPricesResponse' :: ListPricesResponse -> Int
$sel:prices:ListPricesResponse' :: ListPricesResponse -> Maybe [DomainPrice]
$sel:nextPageMarker:ListPricesResponse' :: ListPricesResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageMarker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DomainPrice]
prices
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus