{-# 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.GetCostAndUsage
-- 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 for your account. You can specify which
-- cost and usage-related metric that you want the request to return. For
-- example, you can specify @BlendedCosts@ or @UsageQuantity@. 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.
--
-- For information about filter limitations, see
-- <https://docs.aws.amazon.com/awsaccountbilling/latest/aboutv2/billing-limits.html Quotas and restrictions>
-- in the /Billing and Cost Management User Guide/.
module Amazonka.CostExplorer.GetCostAndUsage
  ( -- * Creating a Request
    GetCostAndUsage (..),
    newGetCostAndUsage,

    -- * Request Lenses
    getCostAndUsage_filter,
    getCostAndUsage_groupBy,
    getCostAndUsage_nextPageToken,
    getCostAndUsage_timePeriod,
    getCostAndUsage_granularity,
    getCostAndUsage_metrics,

    -- * Destructuring the Response
    GetCostAndUsageResponse (..),
    newGetCostAndUsageResponse,

    -- * Response Lenses
    getCostAndUsageResponse_dimensionValueAttributes,
    getCostAndUsageResponse_groupDefinitions,
    getCostAndUsageResponse_nextPageToken,
    getCostAndUsageResponse_resultsByTime,
    getCostAndUsageResponse_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:/ 'newGetCostAndUsage' smart constructor.
data GetCostAndUsage = GetCostAndUsage'
  { -- | 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>.
    --
    -- 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@.
    GetCostAndUsage -> Maybe Expression
filter' :: Prelude.Maybe Expression,
    -- | You can group Amazon Web Services costs using up to two different
    -- groups, either dimensions, tag keys, cost categories, or any two group
    -- by types.
    --
    -- Valid values for the @DIMENSION@ type are @AZ@, @INSTANCE_TYPE@,
    -- @LEGAL_ENTITY_NAME@, @INVOICING_ENTITY@, @LINKED_ACCOUNT@, @OPERATION@,
    -- @PLATFORM@, @PURCHASE_TYPE@, @SERVICE@, @TENANCY@, @RECORD_TYPE@, and
    -- @USAGE_TYPE@.
    --
    -- When you group by the @TAG@ type and include a valid tag key, you get
    -- all tag values, including empty strings.
    GetCostAndUsage -> Maybe [GroupDefinition]
groupBy :: Prelude.Maybe [GroupDefinition],
    -- | 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.
    GetCostAndUsage -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | Sets the start date and end date for retrieving Amazon Web Services
    -- costs. 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@.
    GetCostAndUsage -> DateInterval
timePeriod :: DateInterval,
    -- | Sets the Amazon Web Services cost granularity to @MONTHLY@ or @DAILY@,
    -- or @HOURLY@. If @Granularity@ isn\'t set, the response object doesn\'t
    -- include the @Granularity@, either @MONTHLY@ or @DAILY@, or @HOURLY@.
    GetCostAndUsage -> Granularity
granularity :: Granularity,
    -- | 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 into account the units. 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, hours and GB). To get more
    -- meaningful @UsageQuantity@ metrics, filter by @UsageType@ or
    -- @UsageTypeGroups@.
    --
    -- @Metrics@ is required for @GetCostAndUsage@ requests.
    GetCostAndUsage -> [Text]
metrics :: [Prelude.Text]
  }
  deriving (GetCostAndUsage -> GetCostAndUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCostAndUsage -> GetCostAndUsage -> Bool
$c/= :: GetCostAndUsage -> GetCostAndUsage -> Bool
== :: GetCostAndUsage -> GetCostAndUsage -> Bool
$c== :: GetCostAndUsage -> GetCostAndUsage -> Bool
Prelude.Eq, ReadPrec [GetCostAndUsage]
ReadPrec GetCostAndUsage
Int -> ReadS GetCostAndUsage
ReadS [GetCostAndUsage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCostAndUsage]
$creadListPrec :: ReadPrec [GetCostAndUsage]
readPrec :: ReadPrec GetCostAndUsage
$creadPrec :: ReadPrec GetCostAndUsage
readList :: ReadS [GetCostAndUsage]
$creadList :: ReadS [GetCostAndUsage]
readsPrec :: Int -> ReadS GetCostAndUsage
$creadsPrec :: Int -> ReadS GetCostAndUsage
Prelude.Read, Int -> GetCostAndUsage -> ShowS
[GetCostAndUsage] -> ShowS
GetCostAndUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCostAndUsage] -> ShowS
$cshowList :: [GetCostAndUsage] -> ShowS
show :: GetCostAndUsage -> String
$cshow :: GetCostAndUsage -> String
showsPrec :: Int -> GetCostAndUsage -> ShowS
$cshowsPrec :: Int -> GetCostAndUsage -> ShowS
Prelude.Show, forall x. Rep GetCostAndUsage x -> GetCostAndUsage
forall x. GetCostAndUsage -> Rep GetCostAndUsage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCostAndUsage x -> GetCostAndUsage
$cfrom :: forall x. GetCostAndUsage -> Rep GetCostAndUsage x
Prelude.Generic)

-- |
-- Create a value of 'GetCostAndUsage' 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:
--
-- 'filter'', 'getCostAndUsage_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>.
--
-- 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@.
--
-- 'groupBy', 'getCostAndUsage_groupBy' - You can group Amazon Web Services costs using up to two different
-- groups, either dimensions, tag keys, cost categories, or any two group
-- by types.
--
-- Valid values for the @DIMENSION@ type are @AZ@, @INSTANCE_TYPE@,
-- @LEGAL_ENTITY_NAME@, @INVOICING_ENTITY@, @LINKED_ACCOUNT@, @OPERATION@,
-- @PLATFORM@, @PURCHASE_TYPE@, @SERVICE@, @TENANCY@, @RECORD_TYPE@, and
-- @USAGE_TYPE@.
--
-- When you group by the @TAG@ type and include a valid tag key, you get
-- all tag values, including empty strings.
--
-- 'nextPageToken', 'getCostAndUsage_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', 'getCostAndUsage_timePeriod' - Sets the start date and end date for retrieving Amazon Web Services
-- costs. 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', 'getCostAndUsage_granularity' - Sets the Amazon Web Services cost granularity to @MONTHLY@ or @DAILY@,
-- or @HOURLY@. If @Granularity@ isn\'t set, the response object doesn\'t
-- include the @Granularity@, either @MONTHLY@ or @DAILY@, or @HOURLY@.
--
-- 'metrics', 'getCostAndUsage_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 into account the units. 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, hours and GB). To get more
-- meaningful @UsageQuantity@ metrics, filter by @UsageType@ or
-- @UsageTypeGroups@.
--
-- @Metrics@ is required for @GetCostAndUsage@ requests.
newGetCostAndUsage ::
  -- | 'timePeriod'
  DateInterval ->
  -- | 'granularity'
  Granularity ->
  GetCostAndUsage
newGetCostAndUsage :: DateInterval -> Granularity -> GetCostAndUsage
newGetCostAndUsage DateInterval
pTimePeriod_ Granularity
pGranularity_ =
  GetCostAndUsage'
    { $sel:filter':GetCostAndUsage' :: Maybe Expression
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:groupBy:GetCostAndUsage' :: Maybe [GroupDefinition]
groupBy = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:GetCostAndUsage' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:timePeriod:GetCostAndUsage' :: DateInterval
timePeriod = DateInterval
pTimePeriod_,
      $sel:granularity:GetCostAndUsage' :: Granularity
granularity = Granularity
pGranularity_,
      $sel:metrics:GetCostAndUsage' :: [Text]
metrics = forall a. Monoid a => a
Prelude.mempty
    }

-- | 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>.
--
-- 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@.
getCostAndUsage_filter :: Lens.Lens' GetCostAndUsage (Prelude.Maybe Expression)
getCostAndUsage_filter :: Lens' GetCostAndUsage (Maybe Expression)
getCostAndUsage_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsage' {Maybe Expression
filter' :: Maybe Expression
$sel:filter':GetCostAndUsage' :: GetCostAndUsage -> Maybe Expression
filter'} -> Maybe Expression
filter') (\s :: GetCostAndUsage
s@GetCostAndUsage' {} Maybe Expression
a -> GetCostAndUsage
s {$sel:filter':GetCostAndUsage' :: Maybe Expression
filter' = Maybe Expression
a} :: GetCostAndUsage)

-- | You can group Amazon Web Services costs using up to two different
-- groups, either dimensions, tag keys, cost categories, or any two group
-- by types.
--
-- Valid values for the @DIMENSION@ type are @AZ@, @INSTANCE_TYPE@,
-- @LEGAL_ENTITY_NAME@, @INVOICING_ENTITY@, @LINKED_ACCOUNT@, @OPERATION@,
-- @PLATFORM@, @PURCHASE_TYPE@, @SERVICE@, @TENANCY@, @RECORD_TYPE@, and
-- @USAGE_TYPE@.
--
-- When you group by the @TAG@ type and include a valid tag key, you get
-- all tag values, including empty strings.
getCostAndUsage_groupBy :: Lens.Lens' GetCostAndUsage (Prelude.Maybe [GroupDefinition])
getCostAndUsage_groupBy :: Lens' GetCostAndUsage (Maybe [GroupDefinition])
getCostAndUsage_groupBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsage' {Maybe [GroupDefinition]
groupBy :: Maybe [GroupDefinition]
$sel:groupBy:GetCostAndUsage' :: GetCostAndUsage -> Maybe [GroupDefinition]
groupBy} -> Maybe [GroupDefinition]
groupBy) (\s :: GetCostAndUsage
s@GetCostAndUsage' {} Maybe [GroupDefinition]
a -> GetCostAndUsage
s {$sel:groupBy:GetCostAndUsage' :: Maybe [GroupDefinition]
groupBy = Maybe [GroupDefinition]
a} :: GetCostAndUsage) 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.
getCostAndUsage_nextPageToken :: Lens.Lens' GetCostAndUsage (Prelude.Maybe Prelude.Text)
getCostAndUsage_nextPageToken :: Lens' GetCostAndUsage (Maybe Text)
getCostAndUsage_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsage' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetCostAndUsage' :: GetCostAndUsage -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetCostAndUsage
s@GetCostAndUsage' {} Maybe Text
a -> GetCostAndUsage
s {$sel:nextPageToken:GetCostAndUsage' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetCostAndUsage)

-- | Sets the start date and end date for retrieving Amazon Web Services
-- costs. 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@.
getCostAndUsage_timePeriod :: Lens.Lens' GetCostAndUsage DateInterval
getCostAndUsage_timePeriod :: Lens' GetCostAndUsage DateInterval
getCostAndUsage_timePeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsage' {DateInterval
timePeriod :: DateInterval
$sel:timePeriod:GetCostAndUsage' :: GetCostAndUsage -> DateInterval
timePeriod} -> DateInterval
timePeriod) (\s :: GetCostAndUsage
s@GetCostAndUsage' {} DateInterval
a -> GetCostAndUsage
s {$sel:timePeriod:GetCostAndUsage' :: DateInterval
timePeriod = DateInterval
a} :: GetCostAndUsage)

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

-- | 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 into account the units. 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, hours and GB). To get more
-- meaningful @UsageQuantity@ metrics, filter by @UsageType@ or
-- @UsageTypeGroups@.
--
-- @Metrics@ is required for @GetCostAndUsage@ requests.
getCostAndUsage_metrics :: Lens.Lens' GetCostAndUsage [Prelude.Text]
getCostAndUsage_metrics :: Lens' GetCostAndUsage [Text]
getCostAndUsage_metrics = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsage' {[Text]
metrics :: [Text]
$sel:metrics:GetCostAndUsage' :: GetCostAndUsage -> [Text]
metrics} -> [Text]
metrics) (\s :: GetCostAndUsage
s@GetCostAndUsage' {} [Text]
a -> GetCostAndUsage
s {$sel:metrics:GetCostAndUsage' :: [Text]
metrics = [Text]
a} :: GetCostAndUsage) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

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

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

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

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

-- | /See:/ 'newGetCostAndUsageResponse' smart constructor.
data GetCostAndUsageResponse = GetCostAndUsageResponse'
  { -- | The attributes that apply to a specific dimension value. For example, if
    -- the value is a linked account, the attribute is that account name.
    GetCostAndUsageResponse -> Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes :: Prelude.Maybe [DimensionValuesWithAttributes],
    -- | The groups that are specified by the @Filter@ or @GroupBy@ parameters in
    -- the request.
    GetCostAndUsageResponse -> 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.
    GetCostAndUsageResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The time period that\'s covered by the results in the response.
    GetCostAndUsageResponse -> Maybe [ResultByTime]
resultsByTime :: Prelude.Maybe [ResultByTime],
    -- | The response's http status code.
    GetCostAndUsageResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetCostAndUsageResponse -> GetCostAndUsageResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCostAndUsageResponse -> GetCostAndUsageResponse -> Bool
$c/= :: GetCostAndUsageResponse -> GetCostAndUsageResponse -> Bool
== :: GetCostAndUsageResponse -> GetCostAndUsageResponse -> Bool
$c== :: GetCostAndUsageResponse -> GetCostAndUsageResponse -> Bool
Prelude.Eq, ReadPrec [GetCostAndUsageResponse]
ReadPrec GetCostAndUsageResponse
Int -> ReadS GetCostAndUsageResponse
ReadS [GetCostAndUsageResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCostAndUsageResponse]
$creadListPrec :: ReadPrec [GetCostAndUsageResponse]
readPrec :: ReadPrec GetCostAndUsageResponse
$creadPrec :: ReadPrec GetCostAndUsageResponse
readList :: ReadS [GetCostAndUsageResponse]
$creadList :: ReadS [GetCostAndUsageResponse]
readsPrec :: Int -> ReadS GetCostAndUsageResponse
$creadsPrec :: Int -> ReadS GetCostAndUsageResponse
Prelude.Read, Int -> GetCostAndUsageResponse -> ShowS
[GetCostAndUsageResponse] -> ShowS
GetCostAndUsageResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCostAndUsageResponse] -> ShowS
$cshowList :: [GetCostAndUsageResponse] -> ShowS
show :: GetCostAndUsageResponse -> String
$cshow :: GetCostAndUsageResponse -> String
showsPrec :: Int -> GetCostAndUsageResponse -> ShowS
$cshowsPrec :: Int -> GetCostAndUsageResponse -> ShowS
Prelude.Show, forall x. Rep GetCostAndUsageResponse x -> GetCostAndUsageResponse
forall x. GetCostAndUsageResponse -> Rep GetCostAndUsageResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCostAndUsageResponse x -> GetCostAndUsageResponse
$cfrom :: forall x. GetCostAndUsageResponse -> Rep GetCostAndUsageResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCostAndUsageResponse' 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', 'getCostAndUsageResponse_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', 'getCostAndUsageResponse_groupDefinitions' - The groups that are specified by the @Filter@ or @GroupBy@ parameters in
-- the request.
--
-- 'nextPageToken', 'getCostAndUsageResponse_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', 'getCostAndUsageResponse_resultsByTime' - The time period that\'s covered by the results in the response.
--
-- 'httpStatus', 'getCostAndUsageResponse_httpStatus' - The response's http status code.
newGetCostAndUsageResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetCostAndUsageResponse
newGetCostAndUsageResponse :: Int -> GetCostAndUsageResponse
newGetCostAndUsageResponse Int
pHttpStatus_ =
  GetCostAndUsageResponse'
    { $sel:dimensionValueAttributes:GetCostAndUsageResponse' :: Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:groupDefinitions:GetCostAndUsageResponse' :: Maybe [GroupDefinition]
groupDefinitions = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:GetCostAndUsageResponse' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resultsByTime:GetCostAndUsageResponse' :: Maybe [ResultByTime]
resultsByTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetCostAndUsageResponse' :: 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.
getCostAndUsageResponse_dimensionValueAttributes :: Lens.Lens' GetCostAndUsageResponse (Prelude.Maybe [DimensionValuesWithAttributes])
getCostAndUsageResponse_dimensionValueAttributes :: Lens'
  GetCostAndUsageResponse (Maybe [DimensionValuesWithAttributes])
getCostAndUsageResponse_dimensionValueAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageResponse' {Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes :: Maybe [DimensionValuesWithAttributes]
$sel:dimensionValueAttributes:GetCostAndUsageResponse' :: GetCostAndUsageResponse -> Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes} -> Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes) (\s :: GetCostAndUsageResponse
s@GetCostAndUsageResponse' {} Maybe [DimensionValuesWithAttributes]
a -> GetCostAndUsageResponse
s {$sel:dimensionValueAttributes:GetCostAndUsageResponse' :: Maybe [DimensionValuesWithAttributes]
dimensionValueAttributes = Maybe [DimensionValuesWithAttributes]
a} :: GetCostAndUsageResponse) 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.
getCostAndUsageResponse_groupDefinitions :: Lens.Lens' GetCostAndUsageResponse (Prelude.Maybe [GroupDefinition])
getCostAndUsageResponse_groupDefinitions :: Lens' GetCostAndUsageResponse (Maybe [GroupDefinition])
getCostAndUsageResponse_groupDefinitions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageResponse' {Maybe [GroupDefinition]
groupDefinitions :: Maybe [GroupDefinition]
$sel:groupDefinitions:GetCostAndUsageResponse' :: GetCostAndUsageResponse -> Maybe [GroupDefinition]
groupDefinitions} -> Maybe [GroupDefinition]
groupDefinitions) (\s :: GetCostAndUsageResponse
s@GetCostAndUsageResponse' {} Maybe [GroupDefinition]
a -> GetCostAndUsageResponse
s {$sel:groupDefinitions:GetCostAndUsageResponse' :: Maybe [GroupDefinition]
groupDefinitions = Maybe [GroupDefinition]
a} :: GetCostAndUsageResponse) 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.
getCostAndUsageResponse_nextPageToken :: Lens.Lens' GetCostAndUsageResponse (Prelude.Maybe Prelude.Text)
getCostAndUsageResponse_nextPageToken :: Lens' GetCostAndUsageResponse (Maybe Text)
getCostAndUsageResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostAndUsageResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetCostAndUsageResponse' :: GetCostAndUsageResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetCostAndUsageResponse
s@GetCostAndUsageResponse' {} Maybe Text
a -> GetCostAndUsageResponse
s {$sel:nextPageToken:GetCostAndUsageResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetCostAndUsageResponse)

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

instance Prelude.NFData GetCostAndUsageResponse where
  rnf :: GetCostAndUsageResponse -> ()
rnf GetCostAndUsageResponse' {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:GetCostAndUsageResponse' :: GetCostAndUsageResponse -> Int
$sel:resultsByTime:GetCostAndUsageResponse' :: GetCostAndUsageResponse -> Maybe [ResultByTime]
$sel:nextPageToken:GetCostAndUsageResponse' :: GetCostAndUsageResponse -> Maybe Text
$sel:groupDefinitions:GetCostAndUsageResponse' :: GetCostAndUsageResponse -> Maybe [GroupDefinition]
$sel:dimensionValueAttributes:GetCostAndUsageResponse' :: GetCostAndUsageResponse -> 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