{-# 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.Snowball.ListLongTermPricing
-- 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 all long-term pricing types.
--
-- This operation returns paginated results.
module Amazonka.Snowball.ListLongTermPricing
  ( -- * Creating a Request
    ListLongTermPricing (..),
    newListLongTermPricing,

    -- * Request Lenses
    listLongTermPricing_maxResults,
    listLongTermPricing_nextToken,

    -- * Destructuring the Response
    ListLongTermPricingResponse (..),
    newListLongTermPricingResponse,

    -- * Response Lenses
    listLongTermPricingResponse_longTermPricingEntries,
    listLongTermPricingResponse_nextToken,
    listLongTermPricingResponse_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.Snowball.Types

-- | /See:/ 'newListLongTermPricing' smart constructor.
data ListLongTermPricing = ListLongTermPricing'
  { -- | The maximum number of @ListLongTermPricing@ objects to return.
    ListLongTermPricing -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Because HTTP requests are stateless, this is the starting point for your
    -- next list of @ListLongTermPricing@ to return.
    ListLongTermPricing -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListLongTermPricing -> ListLongTermPricing -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListLongTermPricing -> ListLongTermPricing -> Bool
$c/= :: ListLongTermPricing -> ListLongTermPricing -> Bool
== :: ListLongTermPricing -> ListLongTermPricing -> Bool
$c== :: ListLongTermPricing -> ListLongTermPricing -> Bool
Prelude.Eq, ReadPrec [ListLongTermPricing]
ReadPrec ListLongTermPricing
Int -> ReadS ListLongTermPricing
ReadS [ListLongTermPricing]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListLongTermPricing]
$creadListPrec :: ReadPrec [ListLongTermPricing]
readPrec :: ReadPrec ListLongTermPricing
$creadPrec :: ReadPrec ListLongTermPricing
readList :: ReadS [ListLongTermPricing]
$creadList :: ReadS [ListLongTermPricing]
readsPrec :: Int -> ReadS ListLongTermPricing
$creadsPrec :: Int -> ReadS ListLongTermPricing
Prelude.Read, Int -> ListLongTermPricing -> ShowS
[ListLongTermPricing] -> ShowS
ListLongTermPricing -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListLongTermPricing] -> ShowS
$cshowList :: [ListLongTermPricing] -> ShowS
show :: ListLongTermPricing -> String
$cshow :: ListLongTermPricing -> String
showsPrec :: Int -> ListLongTermPricing -> ShowS
$cshowsPrec :: Int -> ListLongTermPricing -> ShowS
Prelude.Show, forall x. Rep ListLongTermPricing x -> ListLongTermPricing
forall x. ListLongTermPricing -> Rep ListLongTermPricing x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListLongTermPricing x -> ListLongTermPricing
$cfrom :: forall x. ListLongTermPricing -> Rep ListLongTermPricing x
Prelude.Generic)

-- |
-- Create a value of 'ListLongTermPricing' 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', 'listLongTermPricing_maxResults' - The maximum number of @ListLongTermPricing@ objects to return.
--
-- 'nextToken', 'listLongTermPricing_nextToken' - Because HTTP requests are stateless, this is the starting point for your
-- next list of @ListLongTermPricing@ to return.
newListLongTermPricing ::
  ListLongTermPricing
newListLongTermPricing :: ListLongTermPricing
newListLongTermPricing =
  ListLongTermPricing'
    { $sel:maxResults:ListLongTermPricing' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListLongTermPricing' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of @ListLongTermPricing@ objects to return.
listLongTermPricing_maxResults :: Lens.Lens' ListLongTermPricing (Prelude.Maybe Prelude.Natural)
listLongTermPricing_maxResults :: Lens' ListLongTermPricing (Maybe Natural)
listLongTermPricing_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLongTermPricing' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListLongTermPricing' :: ListLongTermPricing -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListLongTermPricing
s@ListLongTermPricing' {} Maybe Natural
a -> ListLongTermPricing
s {$sel:maxResults:ListLongTermPricing' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListLongTermPricing)

-- | Because HTTP requests are stateless, this is the starting point for your
-- next list of @ListLongTermPricing@ to return.
listLongTermPricing_nextToken :: Lens.Lens' ListLongTermPricing (Prelude.Maybe Prelude.Text)
listLongTermPricing_nextToken :: Lens' ListLongTermPricing (Maybe Text)
listLongTermPricing_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLongTermPricing' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLongTermPricing' :: ListLongTermPricing -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListLongTermPricing
s@ListLongTermPricing' {} Maybe Text
a -> ListLongTermPricing
s {$sel:nextToken:ListLongTermPricing' :: Maybe Text
nextToken = Maybe Text
a} :: ListLongTermPricing)

instance Core.AWSPager ListLongTermPricing where
  page :: ListLongTermPricing
-> AWSResponse ListLongTermPricing -> Maybe ListLongTermPricing
page ListLongTermPricing
rq AWSResponse ListLongTermPricing
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListLongTermPricing
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListLongTermPricingResponse (Maybe Text)
listLongTermPricingResponse_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 ListLongTermPricing
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens'
  ListLongTermPricingResponse (Maybe [LongTermPricingListEntry])
listLongTermPricingResponse_longTermPricingEntries
            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.$ ListLongTermPricing
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListLongTermPricing (Maybe Text)
listLongTermPricing_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListLongTermPricing
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListLongTermPricingResponse (Maybe Text)
listLongTermPricingResponse_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 ListLongTermPricing where
  type
    AWSResponse ListLongTermPricing =
      ListLongTermPricingResponse
  request :: (Service -> Service)
-> ListLongTermPricing -> Request ListLongTermPricing
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 ListLongTermPricing
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListLongTermPricing)))
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 [LongTermPricingListEntry]
-> Maybe Text -> Int -> ListLongTermPricingResponse
ListLongTermPricingResponse'
            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
"LongTermPricingEntries"
                            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 ListLongTermPricing where
  hashWithSalt :: Int -> ListLongTermPricing -> Int
hashWithSalt Int
_salt ListLongTermPricing' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListLongTermPricing' :: ListLongTermPricing -> Maybe Text
$sel:maxResults:ListLongTermPricing' :: ListLongTermPricing -> 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 ListLongTermPricing where
  rnf :: ListLongTermPricing -> ()
rnf ListLongTermPricing' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListLongTermPricing' :: ListLongTermPricing -> Maybe Text
$sel:maxResults:ListLongTermPricing' :: ListLongTermPricing -> 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 ListLongTermPricing where
  toHeaders :: ListLongTermPricing -> 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
"AWSIESnowballJobManagementService.ListLongTermPricing" ::
                          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 ListLongTermPricing where
  toJSON :: ListLongTermPricing -> Value
toJSON ListLongTermPricing' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListLongTermPricing' :: ListLongTermPricing -> Maybe Text
$sel:maxResults:ListLongTermPricing' :: ListLongTermPricing -> 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 ListLongTermPricing where
  toPath :: ListLongTermPricing -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newListLongTermPricingResponse' smart constructor.
data ListLongTermPricingResponse = ListLongTermPricingResponse'
  { -- | Each @LongTermPricingEntry@ object contains a status, ID, and other
    -- information about the @LongTermPricing@ type.
    ListLongTermPricingResponse -> Maybe [LongTermPricingListEntry]
longTermPricingEntries :: Prelude.Maybe [LongTermPricingListEntry],
    -- | Because HTTP requests are stateless, this is the starting point for your
    -- next list of returned @ListLongTermPricing@ list.
    ListLongTermPricingResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListLongTermPricingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListLongTermPricingResponse -> ListLongTermPricingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListLongTermPricingResponse -> ListLongTermPricingResponse -> Bool
$c/= :: ListLongTermPricingResponse -> ListLongTermPricingResponse -> Bool
== :: ListLongTermPricingResponse -> ListLongTermPricingResponse -> Bool
$c== :: ListLongTermPricingResponse -> ListLongTermPricingResponse -> Bool
Prelude.Eq, ReadPrec [ListLongTermPricingResponse]
ReadPrec ListLongTermPricingResponse
Int -> ReadS ListLongTermPricingResponse
ReadS [ListLongTermPricingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListLongTermPricingResponse]
$creadListPrec :: ReadPrec [ListLongTermPricingResponse]
readPrec :: ReadPrec ListLongTermPricingResponse
$creadPrec :: ReadPrec ListLongTermPricingResponse
readList :: ReadS [ListLongTermPricingResponse]
$creadList :: ReadS [ListLongTermPricingResponse]
readsPrec :: Int -> ReadS ListLongTermPricingResponse
$creadsPrec :: Int -> ReadS ListLongTermPricingResponse
Prelude.Read, Int -> ListLongTermPricingResponse -> ShowS
[ListLongTermPricingResponse] -> ShowS
ListLongTermPricingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListLongTermPricingResponse] -> ShowS
$cshowList :: [ListLongTermPricingResponse] -> ShowS
show :: ListLongTermPricingResponse -> String
$cshow :: ListLongTermPricingResponse -> String
showsPrec :: Int -> ListLongTermPricingResponse -> ShowS
$cshowsPrec :: Int -> ListLongTermPricingResponse -> ShowS
Prelude.Show, forall x.
Rep ListLongTermPricingResponse x -> ListLongTermPricingResponse
forall x.
ListLongTermPricingResponse -> Rep ListLongTermPricingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListLongTermPricingResponse x -> ListLongTermPricingResponse
$cfrom :: forall x.
ListLongTermPricingResponse -> Rep ListLongTermPricingResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListLongTermPricingResponse' 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:
--
-- 'longTermPricingEntries', 'listLongTermPricingResponse_longTermPricingEntries' - Each @LongTermPricingEntry@ object contains a status, ID, and other
-- information about the @LongTermPricing@ type.
--
-- 'nextToken', 'listLongTermPricingResponse_nextToken' - Because HTTP requests are stateless, this is the starting point for your
-- next list of returned @ListLongTermPricing@ list.
--
-- 'httpStatus', 'listLongTermPricingResponse_httpStatus' - The response's http status code.
newListLongTermPricingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListLongTermPricingResponse
newListLongTermPricingResponse :: Int -> ListLongTermPricingResponse
newListLongTermPricingResponse Int
pHttpStatus_ =
  ListLongTermPricingResponse'
    { $sel:longTermPricingEntries:ListLongTermPricingResponse' :: Maybe [LongTermPricingListEntry]
longTermPricingEntries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListLongTermPricingResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListLongTermPricingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Each @LongTermPricingEntry@ object contains a status, ID, and other
-- information about the @LongTermPricing@ type.
listLongTermPricingResponse_longTermPricingEntries :: Lens.Lens' ListLongTermPricingResponse (Prelude.Maybe [LongTermPricingListEntry])
listLongTermPricingResponse_longTermPricingEntries :: Lens'
  ListLongTermPricingResponse (Maybe [LongTermPricingListEntry])
listLongTermPricingResponse_longTermPricingEntries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLongTermPricingResponse' {Maybe [LongTermPricingListEntry]
longTermPricingEntries :: Maybe [LongTermPricingListEntry]
$sel:longTermPricingEntries:ListLongTermPricingResponse' :: ListLongTermPricingResponse -> Maybe [LongTermPricingListEntry]
longTermPricingEntries} -> Maybe [LongTermPricingListEntry]
longTermPricingEntries) (\s :: ListLongTermPricingResponse
s@ListLongTermPricingResponse' {} Maybe [LongTermPricingListEntry]
a -> ListLongTermPricingResponse
s {$sel:longTermPricingEntries:ListLongTermPricingResponse' :: Maybe [LongTermPricingListEntry]
longTermPricingEntries = Maybe [LongTermPricingListEntry]
a} :: ListLongTermPricingResponse) 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

-- | Because HTTP requests are stateless, this is the starting point for your
-- next list of returned @ListLongTermPricing@ list.
listLongTermPricingResponse_nextToken :: Lens.Lens' ListLongTermPricingResponse (Prelude.Maybe Prelude.Text)
listLongTermPricingResponse_nextToken :: Lens' ListLongTermPricingResponse (Maybe Text)
listLongTermPricingResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListLongTermPricingResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListLongTermPricingResponse' :: ListLongTermPricingResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListLongTermPricingResponse
s@ListLongTermPricingResponse' {} Maybe Text
a -> ListLongTermPricingResponse
s {$sel:nextToken:ListLongTermPricingResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListLongTermPricingResponse)

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

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