{-# 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.CostExplorer.GetCostAndUsageWithResources
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves cost and usage metrics with resources for your account. You
-- can specify which cost and usage-related metric, such as @BlendedCosts@
-- or @UsageQuantity@, that you want the request to return. You can also
-- filter and group your data by various dimensions, such as @SERVICE@ or
-- @AZ@, in a specific time range. For a complete list of valid dimensions,
-- see the
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_GetDimensionValues.html GetDimensionValues>
-- operation. Management account in an organization in Organizations have
-- access to all member accounts. This API is currently available for the
-- Amazon Elastic Compute Cloud – Compute service only.
--
-- This is an opt-in only feature. You can enable this feature from the
-- Cost Explorer Settings page. For information about how to access the
-- Settings page, see
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/ce-access.html Controlling Access for Cost Explorer>
-- in the /Billing and Cost Management User Guide/.
module Amazonka.CostExplorer.GetCostAndUsageWithResources
  ( -- * Creating a Request
    GetCostAndUsageWithResources (..),
    newGetCostAndUsageWithResources,

    -- * Request Lenses
    getCostAndUsageWithResources_groupBy,
    getCostAndUsageWithResources_metrics,
    getCostAndUsageWithResources_nextPageToken,
    getCostAndUsageWithResources_timePeriod,
    getCostAndUsageWithResources_granularity,
    getCostAndUsageWithResources_filter,

    -- * Destructuring the Response
    GetCostAndUsageWithResourcesResponse (..),
    newGetCostAndUsageWithResourcesResponse,

    -- * Response Lenses
    getCostAndUsageWithResourcesResponse_dimensionValueAttributes,
    getCostAndUsageWithResourcesResponse_groupDefinitions,
    getCostAndUsageWithResourcesResponse_nextPageToken,
    getCostAndUsageWithResourcesResponse_resultsByTime,
    getCostAndUsageWithResourcesResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import Amazonka.CostExplorer.Types
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:/ 'newGetCostAndUsageWithResources' smart constructor.
data GetCostAndUsageWithResources = GetCostAndUsageWithResources'
  { -- | You can group Amazon Web Services costs using up to two different
    -- groups: @DIMENSION@, @TAG@, @COST_CATEGORY@.
    GetCostAndUsageWithResources -> Maybe [GroupDefinition]
groupBy :: Prelude.Maybe [GroupDefinition],
    -- | Which metrics are returned in the query. For more information about
    -- blended and unblended rates, see
    -- <http://aws.amazon.com/premiumsupport/knowledge-center/blended-rates-intro/ Why does the \"blended\" annotation appear on some line items in my bill?>.
    --
    -- Valid values are @AmortizedCost@, @BlendedCost@, @NetAmortizedCost@,
    -- @NetUnblendedCost@, @NormalizedUsageAmount@, @UnblendedCost@, and
    -- @UsageQuantity@.
    --
    -- If you return the @UsageQuantity@ metric, the service aggregates all
    -- usage numbers without taking the units into account. For example, if you
    -- aggregate @usageQuantity@ across all of Amazon EC2, the results aren\'t
    -- meaningful because Amazon EC2 compute hours and data transfer are
    -- measured in different units (for example, hour or GB). To get more
    -- meaningful @UsageQuantity@ metrics, filter by @UsageType@ or
    -- @UsageTypeGroups@.
    --
    -- @Metrics@ is required for @GetCostAndUsageWithResources@ requests.
    GetCostAndUsageWithResources -> Maybe [Text]
metrics :: Prelude.Maybe [Prelude.Text],
    -- | The token to retrieve the next set of results. Amazon Web Services
    -- provides the token when the response from a previous call has more
    -- results than the maximum page size.
    GetCostAndUsageWithResources -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | Sets the start and end dates for retrieving Amazon Web Services costs.
    -- The range must be within the last 14 days (the start date cannot be
    -- earlier than 14 days ago). The start date is inclusive, but the end date
    -- is exclusive. For example, if @start@ is @2017-01-01@ and @end@ is
    -- @2017-05-01@, then the cost and usage data is retrieved from
    -- @2017-01-01@ up to and including @2017-04-30@ but not including
    -- @2017-05-01@.
    GetCostAndUsageWithResources -> DateInterval
timePeriod :: DateInterval,
    -- | Sets the Amazon Web Services cost granularity to @MONTHLY@, @DAILY@, or
    -- @HOURLY@. If @Granularity@ isn\'t set, the response object doesn\'t
    -- include the @Granularity@, @MONTHLY@, @DAILY@, or @HOURLY@.
    GetCostAndUsageWithResources -> Granularity
granularity :: Granularity,
    -- | Filters Amazon Web Services costs by different dimensions. For example,
    -- you can specify @SERVICE@ and @LINKED_ACCOUNT@ and get the costs that
    -- are associated with that account\'s usage of that service. You can nest
    -- @Expression@ objects to define any combination of dimension filters. For
    -- more information, see
    -- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>.
    --
    -- The @GetCostAndUsageWithResources@ operation requires that you either
    -- group by or filter by a @ResourceId@. It requires the
    -- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>
    -- @\"SERVICE = Amazon Elastic Compute Cloud - Compute\"@ in the filter.
    --
    -- Valid values for @MatchOptions@ for @Dimensions@ are @EQUALS@ and
    -- @CASE_SENSITIVE@.
    --
    -- Valid values for @MatchOptions@ for @CostCategories@ and @Tags@ are
    -- @EQUALS@, @ABSENT@, and @CASE_SENSITIVE@. Default values are @EQUALS@
    -- and @CASE_SENSITIVE@.
    GetCostAndUsageWithResources -> Expression
filter' :: Expression
  }
  deriving (GetCostAndUsageWithResources
-> GetCostAndUsageWithResources -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCostAndUsageWithResources
-> GetCostAndUsageWithResources -> Bool
$c/= :: GetCostAndUsageWithResources
-> GetCostAndUsageWithResources -> Bool
== :: GetCostAndUsageWithResources
-> GetCostAndUsageWithResources -> Bool
$c== :: GetCostAndUsageWithResources
-> GetCostAndUsageWithResources -> Bool
Prelude.Eq, ReadPrec [GetCostAndUsageWithResources]
ReadPrec GetCostAndUsageWithResources
Int -> ReadS GetCostAndUsageWithResources
ReadS [GetCostAndUsageWithResources]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCostAndUsageWithResources]
$creadListPrec :: ReadPrec [GetCostAndUsageWithResources]
readPrec :: ReadPrec GetCostAndUsageWithResources
$creadPrec :: ReadPrec GetCostAndUsageWithResources
readList :: ReadS [GetCostAndUsageWithResources]
$creadList :: ReadS [GetCostAndUsageWithResources]
readsPrec :: Int -> ReadS GetCostAndUsageWithResources
$creadsPrec :: Int -> ReadS GetCostAndUsageWithResources
Prelude.Read, Int -> GetCostAndUsageWithResources -> ShowS
[GetCostAndUsageWithResources] -> ShowS
GetCostAndUsageWithResources -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCostAndUsageWithResources] -> ShowS
$cshowList :: [GetCostAndUsageWithResources] -> ShowS
show :: GetCostAndUsageWithResources -> String
$cshow :: GetCostAndUsageWithResources -> String
showsPrec :: Int -> GetCostAndUsageWithResources -> ShowS
$cshowsPrec :: Int -> GetCostAndUsageWithResources -> ShowS
Prelude.Show, forall x.
Rep GetCostAndUsageWithResources x -> GetCostAndUsageWithResources
forall x.
GetCostAndUsageWithResources -> Rep GetCostAndUsageWithResources x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCostAndUsageWithResources x -> GetCostAndUsageWithResources
$cfrom :: forall x.
GetCostAndUsageWithResources -> Rep GetCostAndUsageWithResources x
Prelude.Generic)

-- |
-- Create a value of 'GetCostAndUsageWithResources' 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:
--
-- 'groupBy', 'getCostAndUsageWithResources_groupBy' - You can group Amazon Web Services costs using up to two different
-- groups: @DIMENSION@, @TAG@, @COST_CATEGORY@.
--
-- 'metrics', 'getCostAndUsageWithResources_metrics' - Which metrics are returned in the query. For more information about
-- blended and unblended rates, see
-- <http://aws.amazon.com/premiumsupport/knowledge-center/blended-rates-intro/ Why does the \"blended\" annotation appear on some line items in my bill?>.
--
-- Valid values are @AmortizedCost@, @BlendedCost@, @NetAmortizedCost@,
-- @NetUnblendedCost@, @NormalizedUsageAmount@, @UnblendedCost@, and
-- @UsageQuantity@.
--
-- If you return the @UsageQuantity@ metric, the service aggregates all
-- usage numbers without taking the units into account. For example, if you
-- aggregate @usageQuantity@ across all of Amazon EC2, the results aren\'t
-- meaningful because Amazon EC2 compute hours and data transfer are
-- measured in different units (for example, hour or GB). To get more
-- meaningful @UsageQuantity@ metrics, filter by @UsageType@ or
-- @UsageTypeGroups@.
--
-- @Metrics@ is required for @GetCostAndUsageWithResources@ requests.
--
-- 'nextPageToken', 'getCostAndUsageWithResources_nextPageToken' - The token to retrieve the next set of results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
--
-- 'timePeriod', 'getCostAndUsageWithResources_timePeriod' - Sets the start and end dates for retrieving Amazon Web Services costs.
-- The range must be within the last 14 days (the start date cannot be
-- earlier than 14 days ago). The start date is inclusive, but the end date
-- is exclusive. For example, if @start@ is @2017-01-01@ and @end@ is
-- @2017-05-01@, then the cost and usage data is retrieved from
-- @2017-01-01@ up to and including @2017-04-30@ but not including
-- @2017-05-01@.
--
-- 'granularity', 'getCostAndUsageWithResources_granularity' - Sets the Amazon Web Services cost granularity to @MONTHLY@, @DAILY@, or
-- @HOURLY@. If @Granularity@ isn\'t set, the response object doesn\'t
-- include the @Granularity@, @MONTHLY@, @DAILY@, or @HOURLY@.
--
-- 'filter'', 'getCostAndUsageWithResources_filter' - Filters Amazon Web Services costs by different dimensions. For example,
-- you can specify @SERVICE@ and @LINKED_ACCOUNT@ and get the costs that
-- are associated with that account\'s usage of that service. You can nest
-- @Expression@ objects to define any combination of dimension filters. For
-- more information, see
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>.
--
-- The @GetCostAndUsageWithResources@ operation requires that you either
-- group by or filter by a @ResourceId@. It requires the
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>
-- @\"SERVICE = Amazon Elastic Compute Cloud - Compute\"@ in the filter.
--
-- Valid values for @MatchOptions@ for @Dimensions@ are @EQUALS@ and
-- @CASE_SENSITIVE@.
--
-- Valid values for @MatchOptions@ for @CostCategories@ and @Tags@ are
-- @EQUALS@, @ABSENT@, and @CASE_SENSITIVE@. Default values are @EQUALS@
-- and @CASE_SENSITIVE@.
newGetCostAndUsageWithResources ::
  -- | 'timePeriod'
  DateInterval ->
  -- | 'granularity'
  Granularity ->
  -- | 'filter''
  Expression ->
  GetCostAndUsageWithResources
newGetCostAndUsageWithResources :: DateInterval
-> Granularity -> Expression -> GetCostAndUsageWithResources
newGetCostAndUsageWithResources
  DateInterval
pTimePeriod_
  Granularity
pGranularity_
  Expression
pFilter_ =
    GetCostAndUsageWithResources'
      { $sel:groupBy:GetCostAndUsageWithResources' :: Maybe [GroupDefinition]
groupBy =
          forall a. Maybe a
Prelude.Nothing,
        $sel:metrics:GetCostAndUsageWithResources' :: Maybe [Text]
metrics = forall a. Maybe a
Prelude.Nothing,
        $sel:nextPageToken:GetCostAndUsageWithResources' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
        $sel:timePeriod:GetCostAndUsageWithResources' :: DateInterval
timePeriod = DateInterval
pTimePeriod_,
        $sel:granularity:GetCostAndUsageWithResources' :: Granularity
granularity = Granularity
pGranularity_,
        $sel:filter':GetCostAndUsageWithResources' :: Expression
filter' = Expression
pFilter_
      }

-- | You can group Amazon Web Services costs using up to two different
-- groups: @DIMENSION@, @TAG@, @COST_CATEGORY@.
getCostAndUsageWithResources_groupBy :: Lens.Lens' GetCostAndUsageWithResources (Prelude.Maybe [GroupDefinition])
getCostAndUsageWithResources_groupBy :: Lens' GetCostAndUsageWithResources (Maybe [GroupDefinition])
getCostAndUsageWithResources_groupBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResources' {Maybe [GroupDefinition]
groupBy :: Maybe [GroupDefinition]
$sel:groupBy:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe [GroupDefinition]
groupBy} -> Maybe [GroupDefinition]
groupBy) (\s :: GetCostAndUsageWithResources
s@GetCostAndUsageWithResources' {} Maybe [GroupDefinition]
a -> GetCostAndUsageWithResources
s {$sel:groupBy:GetCostAndUsageWithResources' :: Maybe [GroupDefinition]
groupBy = Maybe [GroupDefinition]
a} :: GetCostAndUsageWithResources) 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

-- | Which metrics are returned in the query. For more information about
-- blended and unblended rates, see
-- <http://aws.amazon.com/premiumsupport/knowledge-center/blended-rates-intro/ Why does the \"blended\" annotation appear on some line items in my bill?>.
--
-- Valid values are @AmortizedCost@, @BlendedCost@, @NetAmortizedCost@,
-- @NetUnblendedCost@, @NormalizedUsageAmount@, @UnblendedCost@, and
-- @UsageQuantity@.
--
-- If you return the @UsageQuantity@ metric, the service aggregates all
-- usage numbers without taking the units into account. For example, if you
-- aggregate @usageQuantity@ across all of Amazon EC2, the results aren\'t
-- meaningful because Amazon EC2 compute hours and data transfer are
-- measured in different units (for example, hour or GB). To get more
-- meaningful @UsageQuantity@ metrics, filter by @UsageType@ or
-- @UsageTypeGroups@.
--
-- @Metrics@ is required for @GetCostAndUsageWithResources@ requests.
getCostAndUsageWithResources_metrics :: Lens.Lens' GetCostAndUsageWithResources (Prelude.Maybe [Prelude.Text])
getCostAndUsageWithResources_metrics :: Lens' GetCostAndUsageWithResources (Maybe [Text])
getCostAndUsageWithResources_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResources' {Maybe [Text]
metrics :: Maybe [Text]
$sel:metrics:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe [Text]
metrics} -> Maybe [Text]
metrics) (\s :: GetCostAndUsageWithResources
s@GetCostAndUsageWithResources' {} Maybe [Text]
a -> GetCostAndUsageWithResources
s {$sel:metrics:GetCostAndUsageWithResources' :: Maybe [Text]
metrics = Maybe [Text]
a} :: GetCostAndUsageWithResources) 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 token to retrieve the next set of results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
getCostAndUsageWithResources_nextPageToken :: Lens.Lens' GetCostAndUsageWithResources (Prelude.Maybe Prelude.Text)
getCostAndUsageWithResources_nextPageToken :: Lens' GetCostAndUsageWithResources (Maybe Text)
getCostAndUsageWithResources_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResources' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetCostAndUsageWithResources
s@GetCostAndUsageWithResources' {} Maybe Text
a -> GetCostAndUsageWithResources
s {$sel:nextPageToken:GetCostAndUsageWithResources' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetCostAndUsageWithResources)

-- | Sets the start and end dates for retrieving Amazon Web Services costs.
-- The range must be within the last 14 days (the start date cannot be
-- earlier than 14 days ago). The start date is inclusive, but the end date
-- is exclusive. For example, if @start@ is @2017-01-01@ and @end@ is
-- @2017-05-01@, then the cost and usage data is retrieved from
-- @2017-01-01@ up to and including @2017-04-30@ but not including
-- @2017-05-01@.
getCostAndUsageWithResources_timePeriod :: Lens.Lens' GetCostAndUsageWithResources DateInterval
getCostAndUsageWithResources_timePeriod :: Lens' GetCostAndUsageWithResources DateInterval
getCostAndUsageWithResources_timePeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResources' {DateInterval
timePeriod :: DateInterval
$sel:timePeriod:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> DateInterval
timePeriod} -> DateInterval
timePeriod) (\s :: GetCostAndUsageWithResources
s@GetCostAndUsageWithResources' {} DateInterval
a -> GetCostAndUsageWithResources
s {$sel:timePeriod:GetCostAndUsageWithResources' :: DateInterval
timePeriod = DateInterval
a} :: GetCostAndUsageWithResources)

-- | Sets the Amazon Web Services cost granularity to @MONTHLY@, @DAILY@, or
-- @HOURLY@. If @Granularity@ isn\'t set, the response object doesn\'t
-- include the @Granularity@, @MONTHLY@, @DAILY@, or @HOURLY@.
getCostAndUsageWithResources_granularity :: Lens.Lens' GetCostAndUsageWithResources Granularity
getCostAndUsageWithResources_granularity :: Lens' GetCostAndUsageWithResources Granularity
getCostAndUsageWithResources_granularity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResources' {Granularity
granularity :: Granularity
$sel:granularity:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Granularity
granularity} -> Granularity
granularity) (\s :: GetCostAndUsageWithResources
s@GetCostAndUsageWithResources' {} Granularity
a -> GetCostAndUsageWithResources
s {$sel:granularity:GetCostAndUsageWithResources' :: Granularity
granularity = Granularity
a} :: GetCostAndUsageWithResources)

-- | Filters Amazon Web Services costs by different dimensions. For example,
-- you can specify @SERVICE@ and @LINKED_ACCOUNT@ and get the costs that
-- are associated with that account\'s usage of that service. You can nest
-- @Expression@ objects to define any combination of dimension filters. For
-- more information, see
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>.
--
-- The @GetCostAndUsageWithResources@ operation requires that you either
-- group by or filter by a @ResourceId@. It requires the
-- <https://docs.aws.amazon.com/aws-cost-management/latest/APIReference/API_Expression.html Expression>
-- @\"SERVICE = Amazon Elastic Compute Cloud - Compute\"@ in the filter.
--
-- Valid values for @MatchOptions@ for @Dimensions@ are @EQUALS@ and
-- @CASE_SENSITIVE@.
--
-- Valid values for @MatchOptions@ for @CostCategories@ and @Tags@ are
-- @EQUALS@, @ABSENT@, and @CASE_SENSITIVE@. Default values are @EQUALS@
-- and @CASE_SENSITIVE@.
getCostAndUsageWithResources_filter :: Lens.Lens' GetCostAndUsageWithResources Expression
getCostAndUsageWithResources_filter :: Lens' GetCostAndUsageWithResources Expression
getCostAndUsageWithResources_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResources' {Expression
filter' :: Expression
$sel:filter':GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Expression
filter'} -> Expression
filter') (\s :: GetCostAndUsageWithResources
s@GetCostAndUsageWithResources' {} Expression
a -> GetCostAndUsageWithResources
s {$sel:filter':GetCostAndUsageWithResources' :: Expression
filter' = Expression
a} :: GetCostAndUsageWithResources)

instance Core.AWSRequest GetCostAndUsageWithResources where
  type
    AWSResponse GetCostAndUsageWithResources =
      GetCostAndUsageWithResourcesResponse
  request :: (Service -> Service)
-> GetCostAndUsageWithResources
-> Request GetCostAndUsageWithResources
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 GetCostAndUsageWithResources
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCostAndUsageWithResources)))
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 [DimensionValuesWithAttributes]
-> Maybe [GroupDefinition]
-> Maybe Text
-> Maybe [ResultByTime]
-> Int
-> GetCostAndUsageWithResourcesResponse
GetCostAndUsageWithResourcesResponse'
            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
"DimensionValueAttributes"
                            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
"GroupDefinitions"
                            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
"NextPageToken")
            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
"ResultsByTime" 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
    GetCostAndUsageWithResources
  where
  hashWithSalt :: Int -> GetCostAndUsageWithResources -> Int
hashWithSalt Int
_salt GetCostAndUsageWithResources' {Maybe [Text]
Maybe [GroupDefinition]
Maybe Text
DateInterval
Granularity
Expression
filter' :: Expression
granularity :: Granularity
timePeriod :: DateInterval
nextPageToken :: Maybe Text
metrics :: Maybe [Text]
groupBy :: Maybe [GroupDefinition]
$sel:filter':GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Expression
$sel:granularity:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Granularity
$sel:timePeriod:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> DateInterval
$sel:nextPageToken:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe Text
$sel:metrics:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe [Text]
$sel:groupBy:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe [GroupDefinition]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [GroupDefinition]
groupBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
metrics
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextPageToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DateInterval
timePeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Granularity
granularity
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Expression
filter'

instance Prelude.NFData GetCostAndUsageWithResources where
  rnf :: GetCostAndUsageWithResources -> ()
rnf GetCostAndUsageWithResources' {Maybe [Text]
Maybe [GroupDefinition]
Maybe Text
DateInterval
Granularity
Expression
filter' :: Expression
granularity :: Granularity
timePeriod :: DateInterval
nextPageToken :: Maybe Text
metrics :: Maybe [Text]
groupBy :: Maybe [GroupDefinition]
$sel:filter':GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Expression
$sel:granularity:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Granularity
$sel:timePeriod:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> DateInterval
$sel:nextPageToken:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe Text
$sel:metrics:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe [Text]
$sel:groupBy:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe [GroupDefinition]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [GroupDefinition]
groupBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
metrics
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DateInterval
timePeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Granularity
granularity
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Expression
filter'

instance Data.ToHeaders GetCostAndUsageWithResources where
  toHeaders :: GetCostAndUsageWithResources -> 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
"AWSInsightsIndexService.GetCostAndUsageWithResources" ::
                          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 GetCostAndUsageWithResources where
  toJSON :: GetCostAndUsageWithResources -> Value
toJSON GetCostAndUsageWithResources' {Maybe [Text]
Maybe [GroupDefinition]
Maybe Text
DateInterval
Granularity
Expression
filter' :: Expression
granularity :: Granularity
timePeriod :: DateInterval
nextPageToken :: Maybe Text
metrics :: Maybe [Text]
groupBy :: Maybe [GroupDefinition]
$sel:filter':GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Expression
$sel:granularity:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Granularity
$sel:timePeriod:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> DateInterval
$sel:nextPageToken:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe Text
$sel:metrics:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe [Text]
$sel:groupBy:GetCostAndUsageWithResources' :: GetCostAndUsageWithResources -> Maybe [GroupDefinition]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"GroupBy" 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 [GroupDefinition]
groupBy,
            (Key
"Metrics" 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]
metrics,
            (Key
"NextPageToken" 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
nextPageToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"TimePeriod" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DateInterval
timePeriod),
            forall a. a -> Maybe a
Prelude.Just (Key
"Granularity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Granularity
granularity),
            forall a. a -> Maybe a
Prelude.Just (Key
"Filter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Expression
filter')
          ]
      )

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

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

-- | /See:/ 'newGetCostAndUsageWithResourcesResponse' smart constructor.
data GetCostAndUsageWithResourcesResponse = GetCostAndUsageWithResourcesResponse'
  { -- | The attributes that apply to a specific dimension value. For example, if
    -- the value is a linked account, the attribute is that account name.
    GetCostAndUsageWithResourcesResponse
-> Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes :: Prelude.Maybe [DimensionValuesWithAttributes],
    -- | The groups that are specified by the @Filter@ or @GroupBy@ parameters in
    -- the request.
    GetCostAndUsageWithResourcesResponse -> Maybe [GroupDefinition]
groupDefinitions :: Prelude.Maybe [GroupDefinition],
    -- | The token for the next set of retrievable results. Amazon Web Services
    -- provides the token when the response from a previous call has more
    -- results than the maximum page size.
    GetCostAndUsageWithResourcesResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The time period that\'s covered by the results in the response.
    GetCostAndUsageWithResourcesResponse -> Maybe [ResultByTime]
resultsByTime :: Prelude.Maybe [ResultByTime],
    -- | The response's http status code.
    GetCostAndUsageWithResourcesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCostAndUsageWithResourcesResponse
-> GetCostAndUsageWithResourcesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCostAndUsageWithResourcesResponse
-> GetCostAndUsageWithResourcesResponse -> Bool
$c/= :: GetCostAndUsageWithResourcesResponse
-> GetCostAndUsageWithResourcesResponse -> Bool
== :: GetCostAndUsageWithResourcesResponse
-> GetCostAndUsageWithResourcesResponse -> Bool
$c== :: GetCostAndUsageWithResourcesResponse
-> GetCostAndUsageWithResourcesResponse -> Bool
Prelude.Eq, ReadPrec [GetCostAndUsageWithResourcesResponse]
ReadPrec GetCostAndUsageWithResourcesResponse
Int -> ReadS GetCostAndUsageWithResourcesResponse
ReadS [GetCostAndUsageWithResourcesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCostAndUsageWithResourcesResponse]
$creadListPrec :: ReadPrec [GetCostAndUsageWithResourcesResponse]
readPrec :: ReadPrec GetCostAndUsageWithResourcesResponse
$creadPrec :: ReadPrec GetCostAndUsageWithResourcesResponse
readList :: ReadS [GetCostAndUsageWithResourcesResponse]
$creadList :: ReadS [GetCostAndUsageWithResourcesResponse]
readsPrec :: Int -> ReadS GetCostAndUsageWithResourcesResponse
$creadsPrec :: Int -> ReadS GetCostAndUsageWithResourcesResponse
Prelude.Read, Int -> GetCostAndUsageWithResourcesResponse -> ShowS
[GetCostAndUsageWithResourcesResponse] -> ShowS
GetCostAndUsageWithResourcesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCostAndUsageWithResourcesResponse] -> ShowS
$cshowList :: [GetCostAndUsageWithResourcesResponse] -> ShowS
show :: GetCostAndUsageWithResourcesResponse -> String
$cshow :: GetCostAndUsageWithResourcesResponse -> String
showsPrec :: Int -> GetCostAndUsageWithResourcesResponse -> ShowS
$cshowsPrec :: Int -> GetCostAndUsageWithResourcesResponse -> ShowS
Prelude.Show, forall x.
Rep GetCostAndUsageWithResourcesResponse x
-> GetCostAndUsageWithResourcesResponse
forall x.
GetCostAndUsageWithResourcesResponse
-> Rep GetCostAndUsageWithResourcesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCostAndUsageWithResourcesResponse x
-> GetCostAndUsageWithResourcesResponse
$cfrom :: forall x.
GetCostAndUsageWithResourcesResponse
-> Rep GetCostAndUsageWithResourcesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCostAndUsageWithResourcesResponse' 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:
--
-- 'dimensionValueAttributes', 'getCostAndUsageWithResourcesResponse_dimensionValueAttributes' - The attributes that apply to a specific dimension value. For example, if
-- the value is a linked account, the attribute is that account name.
--
-- 'groupDefinitions', 'getCostAndUsageWithResourcesResponse_groupDefinitions' - The groups that are specified by the @Filter@ or @GroupBy@ parameters in
-- the request.
--
-- 'nextPageToken', 'getCostAndUsageWithResourcesResponse_nextPageToken' - The token for the next set of retrievable results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
--
-- 'resultsByTime', 'getCostAndUsageWithResourcesResponse_resultsByTime' - The time period that\'s covered by the results in the response.
--
-- 'httpStatus', 'getCostAndUsageWithResourcesResponse_httpStatus' - The response's http status code.
newGetCostAndUsageWithResourcesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCostAndUsageWithResourcesResponse
newGetCostAndUsageWithResourcesResponse :: Int -> GetCostAndUsageWithResourcesResponse
newGetCostAndUsageWithResourcesResponse Int
pHttpStatus_ =
  GetCostAndUsageWithResourcesResponse'
    { $sel:dimensionValueAttributes:GetCostAndUsageWithResourcesResponse' :: Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:groupDefinitions:GetCostAndUsageWithResourcesResponse' :: Maybe [GroupDefinition]
groupDefinitions = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:GetCostAndUsageWithResourcesResponse' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resultsByTime:GetCostAndUsageWithResourcesResponse' :: Maybe [ResultByTime]
resultsByTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCostAndUsageWithResourcesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The attributes that apply to a specific dimension value. For example, if
-- the value is a linked account, the attribute is that account name.
getCostAndUsageWithResourcesResponse_dimensionValueAttributes :: Lens.Lens' GetCostAndUsageWithResourcesResponse (Prelude.Maybe [DimensionValuesWithAttributes])
getCostAndUsageWithResourcesResponse_dimensionValueAttributes :: Lens'
  GetCostAndUsageWithResourcesResponse
  (Maybe [DimensionValuesWithAttributes])
getCostAndUsageWithResourcesResponse_dimensionValueAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResourcesResponse' {Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes :: Maybe [DimensionValuesWithAttributes]
$sel:dimensionValueAttributes:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse
-> Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes} -> Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes) (\s :: GetCostAndUsageWithResourcesResponse
s@GetCostAndUsageWithResourcesResponse' {} Maybe [DimensionValuesWithAttributes]
a -> GetCostAndUsageWithResourcesResponse
s {$sel:dimensionValueAttributes:GetCostAndUsageWithResourcesResponse' :: Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes = Maybe [DimensionValuesWithAttributes]
a} :: GetCostAndUsageWithResourcesResponse) 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 groups that are specified by the @Filter@ or @GroupBy@ parameters in
-- the request.
getCostAndUsageWithResourcesResponse_groupDefinitions :: Lens.Lens' GetCostAndUsageWithResourcesResponse (Prelude.Maybe [GroupDefinition])
getCostAndUsageWithResourcesResponse_groupDefinitions :: Lens'
  GetCostAndUsageWithResourcesResponse (Maybe [GroupDefinition])
getCostAndUsageWithResourcesResponse_groupDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResourcesResponse' {Maybe [GroupDefinition]
groupDefinitions :: Maybe [GroupDefinition]
$sel:groupDefinitions:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse -> Maybe [GroupDefinition]
groupDefinitions} -> Maybe [GroupDefinition]
groupDefinitions) (\s :: GetCostAndUsageWithResourcesResponse
s@GetCostAndUsageWithResourcesResponse' {} Maybe [GroupDefinition]
a -> GetCostAndUsageWithResourcesResponse
s {$sel:groupDefinitions:GetCostAndUsageWithResourcesResponse' :: Maybe [GroupDefinition]
groupDefinitions = Maybe [GroupDefinition]
a} :: GetCostAndUsageWithResourcesResponse) 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 token for the next set of retrievable results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
getCostAndUsageWithResourcesResponse_nextPageToken :: Lens.Lens' GetCostAndUsageWithResourcesResponse (Prelude.Maybe Prelude.Text)
getCostAndUsageWithResourcesResponse_nextPageToken :: Lens' GetCostAndUsageWithResourcesResponse (Maybe Text)
getCostAndUsageWithResourcesResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResourcesResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetCostAndUsageWithResourcesResponse
s@GetCostAndUsageWithResourcesResponse' {} Maybe Text
a -> GetCostAndUsageWithResourcesResponse
s {$sel:nextPageToken:GetCostAndUsageWithResourcesResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetCostAndUsageWithResourcesResponse)

-- | The time period that\'s covered by the results in the response.
getCostAndUsageWithResourcesResponse_resultsByTime :: Lens.Lens' GetCostAndUsageWithResourcesResponse (Prelude.Maybe [ResultByTime])
getCostAndUsageWithResourcesResponse_resultsByTime :: Lens' GetCostAndUsageWithResourcesResponse (Maybe [ResultByTime])
getCostAndUsageWithResourcesResponse_resultsByTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResourcesResponse' {Maybe [ResultByTime]
resultsByTime :: Maybe [ResultByTime]
$sel:resultsByTime:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse -> Maybe [ResultByTime]
resultsByTime} -> Maybe [ResultByTime]
resultsByTime) (\s :: GetCostAndUsageWithResourcesResponse
s@GetCostAndUsageWithResourcesResponse' {} Maybe [ResultByTime]
a -> GetCostAndUsageWithResourcesResponse
s {$sel:resultsByTime:GetCostAndUsageWithResourcesResponse' :: Maybe [ResultByTime]
resultsByTime = Maybe [ResultByTime]
a} :: GetCostAndUsageWithResourcesResponse) 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.
getCostAndUsageWithResourcesResponse_httpStatus :: Lens.Lens' GetCostAndUsageWithResourcesResponse Prelude.Int
getCostAndUsageWithResourcesResponse_httpStatus :: Lens' GetCostAndUsageWithResourcesResponse Int
getCostAndUsageWithResourcesResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageWithResourcesResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetCostAndUsageWithResourcesResponse
s@GetCostAndUsageWithResourcesResponse' {} Int
a -> GetCostAndUsageWithResourcesResponse
s {$sel:httpStatus:GetCostAndUsageWithResourcesResponse' :: Int
httpStatus = Int
a} :: GetCostAndUsageWithResourcesResponse)

instance
  Prelude.NFData
    GetCostAndUsageWithResourcesResponse
  where
  rnf :: GetCostAndUsageWithResourcesResponse -> ()
rnf GetCostAndUsageWithResourcesResponse' {Int
Maybe [DimensionValuesWithAttributes]
Maybe [GroupDefinition]
Maybe [ResultByTime]
Maybe Text
httpStatus :: Int
resultsByTime :: Maybe [ResultByTime]
nextPageToken :: Maybe Text
groupDefinitions :: Maybe [GroupDefinition]
dimensionValueAttributes :: Maybe [DimensionValuesWithAttributes]
$sel:httpStatus:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse -> Int
$sel:resultsByTime:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse -> Maybe [ResultByTime]
$sel:nextPageToken:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse -> Maybe Text
$sel:groupDefinitions:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse -> Maybe [GroupDefinition]
$sel:dimensionValueAttributes:GetCostAndUsageWithResourcesResponse' :: GetCostAndUsageWithResourcesResponse
-> Maybe [DimensionValuesWithAttributes]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [GroupDefinition]
groupDefinitions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ResultByTime]
resultsByTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus