{-# 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.ViewBilling
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns all the domain-related billing records for the current Amazon
-- Web Services account for a specified period
--
-- This operation returns paginated results.
module Amazonka.Route53Domains.ViewBilling
  ( -- * Creating a Request
    ViewBilling (..),
    newViewBilling,

    -- * Request Lenses
    viewBilling_end,
    viewBilling_marker,
    viewBilling_maxItems,
    viewBilling_start,

    -- * Destructuring the Response
    ViewBillingResponse (..),
    newViewBillingResponse,

    -- * Response Lenses
    viewBillingResponse_billingRecords,
    viewBillingResponse_nextPageMarker,
    viewBillingResponse_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

-- | The ViewBilling request includes the following elements.
--
-- /See:/ 'newViewBilling' smart constructor.
data ViewBilling = ViewBilling'
  { -- | The end date and time for the time period for which you want a list of
    -- billing records. Specify the date and time in Unix time format and
    -- Coordinated Universal time (UTC).
    ViewBilling -> Maybe POSIX
end :: Prelude.Maybe Data.POSIX,
    -- | For an initial request for a list of billing records, omit this element.
    -- If the number of billing records that are associated with the current
    -- Amazon Web Services account during the specified period is greater than
    -- the value that you specified for @MaxItems@, you can use @Marker@ to
    -- return additional billing records. Get the value of @NextPageMarker@
    -- from the previous response, and submit another request that includes the
    -- value of @NextPageMarker@ in the @Marker@ element.
    --
    -- Constraints: The marker must match the value of @NextPageMarker@ that
    -- was returned in the previous response.
    ViewBilling -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The number of billing records to be returned.
    --
    -- Default: 20
    ViewBilling -> Maybe Int
maxItems :: Prelude.Maybe Prelude.Int,
    -- | The beginning date and time for the time period for which you want a
    -- list of billing records. Specify the date and time in Unix time format
    -- and Coordinated Universal time (UTC).
    ViewBilling -> Maybe POSIX
start :: Prelude.Maybe Data.POSIX
  }
  deriving (ViewBilling -> ViewBilling -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewBilling -> ViewBilling -> Bool
$c/= :: ViewBilling -> ViewBilling -> Bool
== :: ViewBilling -> ViewBilling -> Bool
$c== :: ViewBilling -> ViewBilling -> Bool
Prelude.Eq, ReadPrec [ViewBilling]
ReadPrec ViewBilling
Int -> ReadS ViewBilling
ReadS [ViewBilling]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViewBilling]
$creadListPrec :: ReadPrec [ViewBilling]
readPrec :: ReadPrec ViewBilling
$creadPrec :: ReadPrec ViewBilling
readList :: ReadS [ViewBilling]
$creadList :: ReadS [ViewBilling]
readsPrec :: Int -> ReadS ViewBilling
$creadsPrec :: Int -> ReadS ViewBilling
Prelude.Read, Int -> ViewBilling -> ShowS
[ViewBilling] -> ShowS
ViewBilling -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewBilling] -> ShowS
$cshowList :: [ViewBilling] -> ShowS
show :: ViewBilling -> String
$cshow :: ViewBilling -> String
showsPrec :: Int -> ViewBilling -> ShowS
$cshowsPrec :: Int -> ViewBilling -> ShowS
Prelude.Show, forall x. Rep ViewBilling x -> ViewBilling
forall x. ViewBilling -> Rep ViewBilling x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ViewBilling x -> ViewBilling
$cfrom :: forall x. ViewBilling -> Rep ViewBilling x
Prelude.Generic)

-- |
-- Create a value of 'ViewBilling' 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:
--
-- 'end', 'viewBilling_end' - The end date and time for the time period for which you want a list of
-- billing records. Specify the date and time in Unix time format and
-- Coordinated Universal time (UTC).
--
-- 'marker', 'viewBilling_marker' - For an initial request for a list of billing records, omit this element.
-- If the number of billing records that are associated with the current
-- Amazon Web Services account during the specified period is greater than
-- the value that you specified for @MaxItems@, you can use @Marker@ to
-- return additional billing records. Get the value of @NextPageMarker@
-- from the previous response, and submit another request that includes the
-- value of @NextPageMarker@ in the @Marker@ element.
--
-- Constraints: The marker must match the value of @NextPageMarker@ that
-- was returned in the previous response.
--
-- 'maxItems', 'viewBilling_maxItems' - The number of billing records to be returned.
--
-- Default: 20
--
-- 'start', 'viewBilling_start' - The beginning date and time for the time period for which you want a
-- list of billing records. Specify the date and time in Unix time format
-- and Coordinated Universal time (UTC).
newViewBilling ::
  ViewBilling
newViewBilling :: ViewBilling
newViewBilling =
  ViewBilling'
    { $sel:end:ViewBilling' :: Maybe POSIX
end = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ViewBilling' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ViewBilling' :: Maybe Int
maxItems = forall a. Maybe a
Prelude.Nothing,
      $sel:start:ViewBilling' :: Maybe POSIX
start = forall a. Maybe a
Prelude.Nothing
    }

-- | The end date and time for the time period for which you want a list of
-- billing records. Specify the date and time in Unix time format and
-- Coordinated Universal time (UTC).
viewBilling_end :: Lens.Lens' ViewBilling (Prelude.Maybe Prelude.UTCTime)
viewBilling_end :: Lens' ViewBilling (Maybe UTCTime)
viewBilling_end = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewBilling' {Maybe POSIX
end :: Maybe POSIX
$sel:end:ViewBilling' :: ViewBilling -> Maybe POSIX
end} -> Maybe POSIX
end) (\s :: ViewBilling
s@ViewBilling' {} Maybe POSIX
a -> ViewBilling
s {$sel:end:ViewBilling' :: Maybe POSIX
end = Maybe POSIX
a} :: ViewBilling) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | For an initial request for a list of billing records, omit this element.
-- If the number of billing records that are associated with the current
-- Amazon Web Services account during the specified period is greater than
-- the value that you specified for @MaxItems@, you can use @Marker@ to
-- return additional billing records. Get the value of @NextPageMarker@
-- from the previous response, and submit another request that includes the
-- value of @NextPageMarker@ in the @Marker@ element.
--
-- Constraints: The marker must match the value of @NextPageMarker@ that
-- was returned in the previous response.
viewBilling_marker :: Lens.Lens' ViewBilling (Prelude.Maybe Prelude.Text)
viewBilling_marker :: Lens' ViewBilling (Maybe Text)
viewBilling_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewBilling' {Maybe Text
marker :: Maybe Text
$sel:marker:ViewBilling' :: ViewBilling -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ViewBilling
s@ViewBilling' {} Maybe Text
a -> ViewBilling
s {$sel:marker:ViewBilling' :: Maybe Text
marker = Maybe Text
a} :: ViewBilling)

-- | The number of billing records to be returned.
--
-- Default: 20
viewBilling_maxItems :: Lens.Lens' ViewBilling (Prelude.Maybe Prelude.Int)
viewBilling_maxItems :: Lens' ViewBilling (Maybe Int)
viewBilling_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewBilling' {Maybe Int
maxItems :: Maybe Int
$sel:maxItems:ViewBilling' :: ViewBilling -> Maybe Int
maxItems} -> Maybe Int
maxItems) (\s :: ViewBilling
s@ViewBilling' {} Maybe Int
a -> ViewBilling
s {$sel:maxItems:ViewBilling' :: Maybe Int
maxItems = Maybe Int
a} :: ViewBilling)

-- | The beginning date and time for the time period for which you want a
-- list of billing records. Specify the date and time in Unix time format
-- and Coordinated Universal time (UTC).
viewBilling_start :: Lens.Lens' ViewBilling (Prelude.Maybe Prelude.UTCTime)
viewBilling_start :: Lens' ViewBilling (Maybe UTCTime)
viewBilling_start = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewBilling' {Maybe POSIX
start :: Maybe POSIX
$sel:start:ViewBilling' :: ViewBilling -> Maybe POSIX
start} -> Maybe POSIX
start) (\s :: ViewBilling
s@ViewBilling' {} Maybe POSIX
a -> ViewBilling
s {$sel:start:ViewBilling' :: Maybe POSIX
start = Maybe POSIX
a} :: ViewBilling) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSPager ViewBilling where
  page :: ViewBilling -> AWSResponse ViewBilling -> Maybe ViewBilling
page ViewBilling
rq AWSResponse ViewBilling
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ViewBilling
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ViewBillingResponse (Maybe Text)
viewBillingResponse_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 ViewBilling
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ViewBillingResponse (Maybe [BillingRecord])
viewBillingResponse_billingRecords
            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.$ ViewBilling
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ViewBilling (Maybe Text)
viewBilling_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ViewBilling
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ViewBillingResponse (Maybe Text)
viewBillingResponse_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 ViewBilling where
  type AWSResponse ViewBilling = ViewBillingResponse
  request :: (Service -> Service) -> ViewBilling -> Request ViewBilling
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 ViewBilling
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ViewBilling)))
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 [BillingRecord] -> Maybe Text -> Int -> ViewBillingResponse
ViewBillingResponse'
            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
"BillingRecords" 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
"NextPageMarker")
            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 ViewBilling where
  hashWithSalt :: Int -> ViewBilling -> Int
hashWithSalt Int
_salt ViewBilling' {Maybe Int
Maybe Text
Maybe POSIX
start :: Maybe POSIX
maxItems :: Maybe Int
marker :: Maybe Text
end :: Maybe POSIX
$sel:start:ViewBilling' :: ViewBilling -> Maybe POSIX
$sel:maxItems:ViewBilling' :: ViewBilling -> Maybe Int
$sel:marker:ViewBilling' :: ViewBilling -> Maybe Text
$sel:end:ViewBilling' :: ViewBilling -> Maybe POSIX
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
end
      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 POSIX
start

instance Prelude.NFData ViewBilling where
  rnf :: ViewBilling -> ()
rnf ViewBilling' {Maybe Int
Maybe Text
Maybe POSIX
start :: Maybe POSIX
maxItems :: Maybe Int
marker :: Maybe Text
end :: Maybe POSIX
$sel:start:ViewBilling' :: ViewBilling -> Maybe POSIX
$sel:maxItems:ViewBilling' :: ViewBilling -> Maybe Int
$sel:marker:ViewBilling' :: ViewBilling -> Maybe Text
$sel:end:ViewBilling' :: ViewBilling -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
end
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 POSIX
start

instance Data.ToHeaders ViewBilling where
  toHeaders :: ViewBilling -> 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.ViewBilling" ::
                          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 ViewBilling where
  toJSON :: ViewBilling -> Value
toJSON ViewBilling' {Maybe Int
Maybe Text
Maybe POSIX
start :: Maybe POSIX
maxItems :: Maybe Int
marker :: Maybe Text
end :: Maybe POSIX
$sel:start:ViewBilling' :: ViewBilling -> Maybe POSIX
$sel:maxItems:ViewBilling' :: ViewBilling -> Maybe Int
$sel:marker:ViewBilling' :: ViewBilling -> Maybe Text
$sel:end:ViewBilling' :: ViewBilling -> Maybe POSIX
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"End" 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 POSIX
end,
            (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
"Start" 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 POSIX
start
          ]
      )

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

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

-- | The ViewBilling response includes the following elements.
--
-- /See:/ 'newViewBillingResponse' smart constructor.
data ViewBillingResponse = ViewBillingResponse'
  { -- | A summary of billing records.
    ViewBillingResponse -> Maybe [BillingRecord]
billingRecords :: Prelude.Maybe [BillingRecord],
    -- | If there are more billing records than you specified for @MaxItems@ in
    -- the request, submit another request and include the value of
    -- @NextPageMarker@ in the value of @Marker@.
    ViewBillingResponse -> Maybe Text
nextPageMarker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ViewBillingResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ViewBillingResponse -> ViewBillingResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewBillingResponse -> ViewBillingResponse -> Bool
$c/= :: ViewBillingResponse -> ViewBillingResponse -> Bool
== :: ViewBillingResponse -> ViewBillingResponse -> Bool
$c== :: ViewBillingResponse -> ViewBillingResponse -> Bool
Prelude.Eq, ReadPrec [ViewBillingResponse]
ReadPrec ViewBillingResponse
Int -> ReadS ViewBillingResponse
ReadS [ViewBillingResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ViewBillingResponse]
$creadListPrec :: ReadPrec [ViewBillingResponse]
readPrec :: ReadPrec ViewBillingResponse
$creadPrec :: ReadPrec ViewBillingResponse
readList :: ReadS [ViewBillingResponse]
$creadList :: ReadS [ViewBillingResponse]
readsPrec :: Int -> ReadS ViewBillingResponse
$creadsPrec :: Int -> ReadS ViewBillingResponse
Prelude.Read, Int -> ViewBillingResponse -> ShowS
[ViewBillingResponse] -> ShowS
ViewBillingResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewBillingResponse] -> ShowS
$cshowList :: [ViewBillingResponse] -> ShowS
show :: ViewBillingResponse -> String
$cshow :: ViewBillingResponse -> String
showsPrec :: Int -> ViewBillingResponse -> ShowS
$cshowsPrec :: Int -> ViewBillingResponse -> ShowS
Prelude.Show, forall x. Rep ViewBillingResponse x -> ViewBillingResponse
forall x. ViewBillingResponse -> Rep ViewBillingResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ViewBillingResponse x -> ViewBillingResponse
$cfrom :: forall x. ViewBillingResponse -> Rep ViewBillingResponse x
Prelude.Generic)

-- |
-- Create a value of 'ViewBillingResponse' 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:
--
-- 'billingRecords', 'viewBillingResponse_billingRecords' - A summary of billing records.
--
-- 'nextPageMarker', 'viewBillingResponse_nextPageMarker' - If there are more billing records than you specified for @MaxItems@ in
-- the request, submit another request and include the value of
-- @NextPageMarker@ in the value of @Marker@.
--
-- 'httpStatus', 'viewBillingResponse_httpStatus' - The response's http status code.
newViewBillingResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ViewBillingResponse
newViewBillingResponse :: Int -> ViewBillingResponse
newViewBillingResponse Int
pHttpStatus_ =
  ViewBillingResponse'
    { $sel:billingRecords:ViewBillingResponse' :: Maybe [BillingRecord]
billingRecords =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageMarker:ViewBillingResponse' :: Maybe Text
nextPageMarker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ViewBillingResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A summary of billing records.
viewBillingResponse_billingRecords :: Lens.Lens' ViewBillingResponse (Prelude.Maybe [BillingRecord])
viewBillingResponse_billingRecords :: Lens' ViewBillingResponse (Maybe [BillingRecord])
viewBillingResponse_billingRecords = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewBillingResponse' {Maybe [BillingRecord]
billingRecords :: Maybe [BillingRecord]
$sel:billingRecords:ViewBillingResponse' :: ViewBillingResponse -> Maybe [BillingRecord]
billingRecords} -> Maybe [BillingRecord]
billingRecords) (\s :: ViewBillingResponse
s@ViewBillingResponse' {} Maybe [BillingRecord]
a -> ViewBillingResponse
s {$sel:billingRecords:ViewBillingResponse' :: Maybe [BillingRecord]
billingRecords = Maybe [BillingRecord]
a} :: ViewBillingResponse) 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

-- | If there are more billing records than you specified for @MaxItems@ in
-- the request, submit another request and include the value of
-- @NextPageMarker@ in the value of @Marker@.
viewBillingResponse_nextPageMarker :: Lens.Lens' ViewBillingResponse (Prelude.Maybe Prelude.Text)
viewBillingResponse_nextPageMarker :: Lens' ViewBillingResponse (Maybe Text)
viewBillingResponse_nextPageMarker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ViewBillingResponse' {Maybe Text
nextPageMarker :: Maybe Text
$sel:nextPageMarker:ViewBillingResponse' :: ViewBillingResponse -> Maybe Text
nextPageMarker} -> Maybe Text
nextPageMarker) (\s :: ViewBillingResponse
s@ViewBillingResponse' {} Maybe Text
a -> ViewBillingResponse
s {$sel:nextPageMarker:ViewBillingResponse' :: Maybe Text
nextPageMarker = Maybe Text
a} :: ViewBillingResponse)

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

instance Prelude.NFData ViewBillingResponse where
  rnf :: ViewBillingResponse -> ()
rnf ViewBillingResponse' {Int
Maybe [BillingRecord]
Maybe Text
httpStatus :: Int
nextPageMarker :: Maybe Text
billingRecords :: Maybe [BillingRecord]
$sel:httpStatus:ViewBillingResponse' :: ViewBillingResponse -> Int
$sel:nextPageMarker:ViewBillingResponse' :: ViewBillingResponse -> Maybe Text
$sel:billingRecords:ViewBillingResponse' :: ViewBillingResponse -> Maybe [BillingRecord]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [BillingRecord]
billingRecords
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Int
httpStatus