{-# 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.BillingConductor.ListPricingPlans
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A paginated call to get pricing plans for the given billing period. If
-- you don\'t provide a billing period, the current billing period is used.
--
-- This operation returns paginated results.
module Amazonka.BillingConductor.ListPricingPlans
  ( -- * Creating a Request
    ListPricingPlans (..),
    newListPricingPlans,

    -- * Request Lenses
    listPricingPlans_billingPeriod,
    listPricingPlans_filters,
    listPricingPlans_maxResults,
    listPricingPlans_nextToken,

    -- * Destructuring the Response
    ListPricingPlansResponse (..),
    newListPricingPlansResponse,

    -- * Response Lenses
    listPricingPlansResponse_billingPeriod,
    listPricingPlansResponse_nextToken,
    listPricingPlansResponse_pricingPlans,
    listPricingPlansResponse_httpStatus,
  )
where

import Amazonka.BillingConductor.Types
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

-- | /See:/ 'newListPricingPlans' smart constructor.
data ListPricingPlans = ListPricingPlans'
  { -- | The preferred billing period to get pricing plan.
    ListPricingPlans -> Maybe Text
billingPeriod :: Prelude.Maybe Prelude.Text,
    -- | A @ListPricingPlansFilter@ that specifies the Amazon Resource Name
    -- (ARNs) of pricing plans to retrieve pricing plans information.
    ListPricingPlans -> Maybe ListPricingPlansFilter
filters :: Prelude.Maybe ListPricingPlansFilter,
    -- | The maximum number of pricing plans to retrieve.
    ListPricingPlans -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The pagination token that\'s used on subsequent call to get pricing
    -- plans.
    ListPricingPlans -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListPricingPlans -> ListPricingPlans -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPricingPlans -> ListPricingPlans -> Bool
$c/= :: ListPricingPlans -> ListPricingPlans -> Bool
== :: ListPricingPlans -> ListPricingPlans -> Bool
$c== :: ListPricingPlans -> ListPricingPlans -> Bool
Prelude.Eq, ReadPrec [ListPricingPlans]
ReadPrec ListPricingPlans
Int -> ReadS ListPricingPlans
ReadS [ListPricingPlans]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListPricingPlans]
$creadListPrec :: ReadPrec [ListPricingPlans]
readPrec :: ReadPrec ListPricingPlans
$creadPrec :: ReadPrec ListPricingPlans
readList :: ReadS [ListPricingPlans]
$creadList :: ReadS [ListPricingPlans]
readsPrec :: Int -> ReadS ListPricingPlans
$creadsPrec :: Int -> ReadS ListPricingPlans
Prelude.Read, Int -> ListPricingPlans -> ShowS
[ListPricingPlans] -> ShowS
ListPricingPlans -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPricingPlans] -> ShowS
$cshowList :: [ListPricingPlans] -> ShowS
show :: ListPricingPlans -> String
$cshow :: ListPricingPlans -> String
showsPrec :: Int -> ListPricingPlans -> ShowS
$cshowsPrec :: Int -> ListPricingPlans -> ShowS
Prelude.Show, forall x. Rep ListPricingPlans x -> ListPricingPlans
forall x. ListPricingPlans -> Rep ListPricingPlans x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListPricingPlans x -> ListPricingPlans
$cfrom :: forall x. ListPricingPlans -> Rep ListPricingPlans x
Prelude.Generic)

-- |
-- Create a value of 'ListPricingPlans' 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:
--
-- 'billingPeriod', 'listPricingPlans_billingPeriod' - The preferred billing period to get pricing plan.
--
-- 'filters', 'listPricingPlans_filters' - A @ListPricingPlansFilter@ that specifies the Amazon Resource Name
-- (ARNs) of pricing plans to retrieve pricing plans information.
--
-- 'maxResults', 'listPricingPlans_maxResults' - The maximum number of pricing plans to retrieve.
--
-- 'nextToken', 'listPricingPlans_nextToken' - The pagination token that\'s used on subsequent call to get pricing
-- plans.
newListPricingPlans ::
  ListPricingPlans
newListPricingPlans :: ListPricingPlans
newListPricingPlans =
  ListPricingPlans'
    { $sel:billingPeriod:ListPricingPlans' :: Maybe Text
billingPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:ListPricingPlans' :: Maybe ListPricingPlansFilter
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListPricingPlans' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPricingPlans' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The preferred billing period to get pricing plan.
listPricingPlans_billingPeriod :: Lens.Lens' ListPricingPlans (Prelude.Maybe Prelude.Text)
listPricingPlans_billingPeriod :: Lens' ListPricingPlans (Maybe Text)
listPricingPlans_billingPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricingPlans' {Maybe Text
billingPeriod :: Maybe Text
$sel:billingPeriod:ListPricingPlans' :: ListPricingPlans -> Maybe Text
billingPeriod} -> Maybe Text
billingPeriod) (\s :: ListPricingPlans
s@ListPricingPlans' {} Maybe Text
a -> ListPricingPlans
s {$sel:billingPeriod:ListPricingPlans' :: Maybe Text
billingPeriod = Maybe Text
a} :: ListPricingPlans)

-- | A @ListPricingPlansFilter@ that specifies the Amazon Resource Name
-- (ARNs) of pricing plans to retrieve pricing plans information.
listPricingPlans_filters :: Lens.Lens' ListPricingPlans (Prelude.Maybe ListPricingPlansFilter)
listPricingPlans_filters :: Lens' ListPricingPlans (Maybe ListPricingPlansFilter)
listPricingPlans_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricingPlans' {Maybe ListPricingPlansFilter
filters :: Maybe ListPricingPlansFilter
$sel:filters:ListPricingPlans' :: ListPricingPlans -> Maybe ListPricingPlansFilter
filters} -> Maybe ListPricingPlansFilter
filters) (\s :: ListPricingPlans
s@ListPricingPlans' {} Maybe ListPricingPlansFilter
a -> ListPricingPlans
s {$sel:filters:ListPricingPlans' :: Maybe ListPricingPlansFilter
filters = Maybe ListPricingPlansFilter
a} :: ListPricingPlans)

-- | The maximum number of pricing plans to retrieve.
listPricingPlans_maxResults :: Lens.Lens' ListPricingPlans (Prelude.Maybe Prelude.Natural)
listPricingPlans_maxResults :: Lens' ListPricingPlans (Maybe Natural)
listPricingPlans_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricingPlans' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListPricingPlans' :: ListPricingPlans -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListPricingPlans
s@ListPricingPlans' {} Maybe Natural
a -> ListPricingPlans
s {$sel:maxResults:ListPricingPlans' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListPricingPlans)

-- | The pagination token that\'s used on subsequent call to get pricing
-- plans.
listPricingPlans_nextToken :: Lens.Lens' ListPricingPlans (Prelude.Maybe Prelude.Text)
listPricingPlans_nextToken :: Lens' ListPricingPlans (Maybe Text)
listPricingPlans_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricingPlans' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPricingPlans' :: ListPricingPlans -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPricingPlans
s@ListPricingPlans' {} Maybe Text
a -> ListPricingPlans
s {$sel:nextToken:ListPricingPlans' :: Maybe Text
nextToken = Maybe Text
a} :: ListPricingPlans)

instance Core.AWSPager ListPricingPlans where
  page :: ListPricingPlans
-> AWSResponse ListPricingPlans -> Maybe ListPricingPlans
page ListPricingPlans
rq AWSResponse ListPricingPlans
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListPricingPlans
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPricingPlansResponse (Maybe Text)
listPricingPlansResponse_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 ListPricingPlans
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPricingPlansResponse (Maybe [PricingPlanListElement])
listPricingPlansResponse_pricingPlans
            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.$ ListPricingPlans
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListPricingPlans (Maybe Text)
listPricingPlans_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListPricingPlans
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListPricingPlansResponse (Maybe Text)
listPricingPlansResponse_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 ListPricingPlans where
  type
    AWSResponse ListPricingPlans =
      ListPricingPlansResponse
  request :: (Service -> Service)
-> ListPricingPlans -> Request ListPricingPlans
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 ListPricingPlans
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListPricingPlans)))
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 Text
-> Maybe [PricingPlanListElement]
-> Int
-> ListPricingPlansResponse
ListPricingPlansResponse'
            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
"BillingPeriod")
            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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PricingPlans" 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 ListPricingPlans where
  hashWithSalt :: Int -> ListPricingPlans -> Int
hashWithSalt Int
_salt ListPricingPlans' {Maybe Natural
Maybe Text
Maybe ListPricingPlansFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe ListPricingPlansFilter
billingPeriod :: Maybe Text
$sel:nextToken:ListPricingPlans' :: ListPricingPlans -> Maybe Text
$sel:maxResults:ListPricingPlans' :: ListPricingPlans -> Maybe Natural
$sel:filters:ListPricingPlans' :: ListPricingPlans -> Maybe ListPricingPlansFilter
$sel:billingPeriod:ListPricingPlans' :: ListPricingPlans -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
billingPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ListPricingPlansFilter
filters
      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 ListPricingPlans where
  rnf :: ListPricingPlans -> ()
rnf ListPricingPlans' {Maybe Natural
Maybe Text
Maybe ListPricingPlansFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe ListPricingPlansFilter
billingPeriod :: Maybe Text
$sel:nextToken:ListPricingPlans' :: ListPricingPlans -> Maybe Text
$sel:maxResults:ListPricingPlans' :: ListPricingPlans -> Maybe Natural
$sel:filters:ListPricingPlans' :: ListPricingPlans -> Maybe ListPricingPlansFilter
$sel:billingPeriod:ListPricingPlans' :: ListPricingPlans -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
billingPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ListPricingPlansFilter
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 ListPricingPlans where
  toHeaders :: ListPricingPlans -> 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.ToJSON ListPricingPlans where
  toJSON :: ListPricingPlans -> Value
toJSON ListPricingPlans' {Maybe Natural
Maybe Text
Maybe ListPricingPlansFilter
nextToken :: Maybe Text
maxResults :: Maybe Natural
filters :: Maybe ListPricingPlansFilter
billingPeriod :: Maybe Text
$sel:nextToken:ListPricingPlans' :: ListPricingPlans -> Maybe Text
$sel:maxResults:ListPricingPlans' :: ListPricingPlans -> Maybe Natural
$sel:filters:ListPricingPlans' :: ListPricingPlans -> Maybe ListPricingPlansFilter
$sel:billingPeriod:ListPricingPlans' :: ListPricingPlans -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"BillingPeriod" 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
billingPeriod,
            (Key
"Filters" 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 ListPricingPlansFilter
filters,
            (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 ListPricingPlans where
  toPath :: ListPricingPlans -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/list-pricing-plans"

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

-- | /See:/ 'newListPricingPlansResponse' smart constructor.
data ListPricingPlansResponse = ListPricingPlansResponse'
  { -- | The billing period for which the described pricing plans are applicable.
    ListPricingPlansResponse -> Maybe Text
billingPeriod :: Prelude.Maybe Prelude.Text,
    -- | The pagination token that\'s used on subsequent calls to get pricing
    -- plans.
    ListPricingPlansResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of @PricingPlanListElement@ retrieved.
    ListPricingPlansResponse -> Maybe [PricingPlanListElement]
pricingPlans :: Prelude.Maybe [PricingPlanListElement],
    -- | The response's http status code.
    ListPricingPlansResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListPricingPlansResponse -> ListPricingPlansResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListPricingPlansResponse -> ListPricingPlansResponse -> Bool
$c/= :: ListPricingPlansResponse -> ListPricingPlansResponse -> Bool
== :: ListPricingPlansResponse -> ListPricingPlansResponse -> Bool
$c== :: ListPricingPlansResponse -> ListPricingPlansResponse -> Bool
Prelude.Eq, Int -> ListPricingPlansResponse -> ShowS
[ListPricingPlansResponse] -> ShowS
ListPricingPlansResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListPricingPlansResponse] -> ShowS
$cshowList :: [ListPricingPlansResponse] -> ShowS
show :: ListPricingPlansResponse -> String
$cshow :: ListPricingPlansResponse -> String
showsPrec :: Int -> ListPricingPlansResponse -> ShowS
$cshowsPrec :: Int -> ListPricingPlansResponse -> ShowS
Prelude.Show, forall x.
Rep ListPricingPlansResponse x -> ListPricingPlansResponse
forall x.
ListPricingPlansResponse -> Rep ListPricingPlansResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListPricingPlansResponse x -> ListPricingPlansResponse
$cfrom :: forall x.
ListPricingPlansResponse -> Rep ListPricingPlansResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListPricingPlansResponse' 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:
--
-- 'billingPeriod', 'listPricingPlansResponse_billingPeriod' - The billing period for which the described pricing plans are applicable.
--
-- 'nextToken', 'listPricingPlansResponse_nextToken' - The pagination token that\'s used on subsequent calls to get pricing
-- plans.
--
-- 'pricingPlans', 'listPricingPlansResponse_pricingPlans' - A list of @PricingPlanListElement@ retrieved.
--
-- 'httpStatus', 'listPricingPlansResponse_httpStatus' - The response's http status code.
newListPricingPlansResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListPricingPlansResponse
newListPricingPlansResponse :: Int -> ListPricingPlansResponse
newListPricingPlansResponse Int
pHttpStatus_ =
  ListPricingPlansResponse'
    { $sel:billingPeriod:ListPricingPlansResponse' :: Maybe Text
billingPeriod =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListPricingPlansResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pricingPlans:ListPricingPlansResponse' :: Maybe [PricingPlanListElement]
pricingPlans = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListPricingPlansResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The billing period for which the described pricing plans are applicable.
listPricingPlansResponse_billingPeriod :: Lens.Lens' ListPricingPlansResponse (Prelude.Maybe Prelude.Text)
listPricingPlansResponse_billingPeriod :: Lens' ListPricingPlansResponse (Maybe Text)
listPricingPlansResponse_billingPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricingPlansResponse' {Maybe Text
billingPeriod :: Maybe Text
$sel:billingPeriod:ListPricingPlansResponse' :: ListPricingPlansResponse -> Maybe Text
billingPeriod} -> Maybe Text
billingPeriod) (\s :: ListPricingPlansResponse
s@ListPricingPlansResponse' {} Maybe Text
a -> ListPricingPlansResponse
s {$sel:billingPeriod:ListPricingPlansResponse' :: Maybe Text
billingPeriod = Maybe Text
a} :: ListPricingPlansResponse)

-- | The pagination token that\'s used on subsequent calls to get pricing
-- plans.
listPricingPlansResponse_nextToken :: Lens.Lens' ListPricingPlansResponse (Prelude.Maybe Prelude.Text)
listPricingPlansResponse_nextToken :: Lens' ListPricingPlansResponse (Maybe Text)
listPricingPlansResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricingPlansResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListPricingPlansResponse' :: ListPricingPlansResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListPricingPlansResponse
s@ListPricingPlansResponse' {} Maybe Text
a -> ListPricingPlansResponse
s {$sel:nextToken:ListPricingPlansResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListPricingPlansResponse)

-- | A list of @PricingPlanListElement@ retrieved.
listPricingPlansResponse_pricingPlans :: Lens.Lens' ListPricingPlansResponse (Prelude.Maybe [PricingPlanListElement])
listPricingPlansResponse_pricingPlans :: Lens' ListPricingPlansResponse (Maybe [PricingPlanListElement])
listPricingPlansResponse_pricingPlans = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricingPlansResponse' {Maybe [PricingPlanListElement]
pricingPlans :: Maybe [PricingPlanListElement]
$sel:pricingPlans:ListPricingPlansResponse' :: ListPricingPlansResponse -> Maybe [PricingPlanListElement]
pricingPlans} -> Maybe [PricingPlanListElement]
pricingPlans) (\s :: ListPricingPlansResponse
s@ListPricingPlansResponse' {} Maybe [PricingPlanListElement]
a -> ListPricingPlansResponse
s {$sel:pricingPlans:ListPricingPlansResponse' :: Maybe [PricingPlanListElement]
pricingPlans = Maybe [PricingPlanListElement]
a} :: ListPricingPlansResponse) 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.
listPricingPlansResponse_httpStatus :: Lens.Lens' ListPricingPlansResponse Prelude.Int
listPricingPlansResponse_httpStatus :: Lens' ListPricingPlansResponse Int
listPricingPlansResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListPricingPlansResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListPricingPlansResponse' :: ListPricingPlansResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListPricingPlansResponse
s@ListPricingPlansResponse' {} Int
a -> ListPricingPlansResponse
s {$sel:httpStatus:ListPricingPlansResponse' :: Int
httpStatus = Int
a} :: ListPricingPlansResponse)

instance Prelude.NFData ListPricingPlansResponse where
  rnf :: ListPricingPlansResponse -> ()
rnf ListPricingPlansResponse' {Int
Maybe [PricingPlanListElement]
Maybe Text
httpStatus :: Int
pricingPlans :: Maybe [PricingPlanListElement]
nextToken :: Maybe Text
billingPeriod :: Maybe Text
$sel:httpStatus:ListPricingPlansResponse' :: ListPricingPlansResponse -> Int
$sel:pricingPlans:ListPricingPlansResponse' :: ListPricingPlansResponse -> Maybe [PricingPlanListElement]
$sel:nextToken:ListPricingPlansResponse' :: ListPricingPlansResponse -> Maybe Text
$sel:billingPeriod:ListPricingPlansResponse' :: ListPricingPlansResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
billingPeriod
      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 Maybe [PricingPlanListElement]
pricingPlans
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus