{-# 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.GetUsageForecast
-- 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 a forecast for how much Amazon Web Services predicts that you
-- will use over the forecast time period that you select, based on your
-- past usage.
module Amazonka.CostExplorer.GetUsageForecast
  ( -- * Creating a Request
    GetUsageForecast (..),
    newGetUsageForecast,

    -- * Request Lenses
    getUsageForecast_filter,
    getUsageForecast_predictionIntervalLevel,
    getUsageForecast_timePeriod,
    getUsageForecast_metric,
    getUsageForecast_granularity,

    -- * Destructuring the Response
    GetUsageForecastResponse (..),
    newGetUsageForecastResponse,

    -- * Response Lenses
    getUsageForecastResponse_forecastResultsByTime,
    getUsageForecastResponse_total,
    getUsageForecastResponse_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:/ 'newGetUsageForecast' smart constructor.
data GetUsageForecast = GetUsageForecast'
  { -- | The filters that you want to use to filter your forecast. The
    -- @GetUsageForecast@ API supports filtering by the following dimensions:
    --
    -- -   @AZ@
    --
    -- -   @INSTANCE_TYPE@
    --
    -- -   @LINKED_ACCOUNT@
    --
    -- -   @LINKED_ACCOUNT_NAME@
    --
    -- -   @OPERATION@
    --
    -- -   @PURCHASE_TYPE@
    --
    -- -   @REGION@
    --
    -- -   @SERVICE@
    --
    -- -   @USAGE_TYPE@
    --
    -- -   @USAGE_TYPE_GROUP@
    --
    -- -   @RECORD_TYPE@
    --
    -- -   @OPERATING_SYSTEM@
    --
    -- -   @TENANCY@
    --
    -- -   @SCOPE@
    --
    -- -   @PLATFORM@
    --
    -- -   @SUBSCRIPTION_ID@
    --
    -- -   @LEGAL_ENTITY_NAME@
    --
    -- -   @DEPLOYMENT_OPTION@
    --
    -- -   @DATABASE_ENGINE@
    --
    -- -   @INSTANCE_TYPE_FAMILY@
    --
    -- -   @BILLING_ENTITY@
    --
    -- -   @RESERVATION_ID@
    --
    -- -   @SAVINGS_PLAN_ARN@
    GetUsageForecast -> Maybe Expression
filter' :: Prelude.Maybe Expression,
    -- | Amazon Web Services Cost Explorer always returns the mean forecast as a
    -- single point. You can request a prediction interval around the mean by
    -- specifying a confidence level. The higher the confidence level, the more
    -- confident Cost Explorer is about the actual value falling in the
    -- prediction interval. Higher confidence levels result in wider prediction
    -- intervals.
    GetUsageForecast -> Maybe Natural
predictionIntervalLevel :: Prelude.Maybe Prelude.Natural,
    -- | The start and end dates of the period that you want to retrieve usage
    -- forecast for. The start date is included in the period, but the end date
    -- isn\'t included in the period. 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@. The start date must be equal to or later than the current
    -- date to avoid a validation error.
    GetUsageForecast -> DateInterval
timePeriod :: DateInterval,
    -- | Which metric Cost Explorer uses to create your forecast.
    --
    -- Valid values for a @GetUsageForecast@ call are the following:
    --
    -- -   USAGE_QUANTITY
    --
    -- -   NORMALIZED_USAGE_AMOUNT
    GetUsageForecast -> Metric
metric :: Metric,
    -- | How granular you want the forecast to be. You can get 3 months of
    -- @DAILY@ forecasts or 12 months of @MONTHLY@ forecasts.
    --
    -- The @GetUsageForecast@ operation supports only @DAILY@ and @MONTHLY@
    -- granularities.
    GetUsageForecast -> Granularity
granularity :: Granularity
  }
  deriving (GetUsageForecast -> GetUsageForecast -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUsageForecast -> GetUsageForecast -> Bool
$c/= :: GetUsageForecast -> GetUsageForecast -> Bool
== :: GetUsageForecast -> GetUsageForecast -> Bool
$c== :: GetUsageForecast -> GetUsageForecast -> Bool
Prelude.Eq, ReadPrec [GetUsageForecast]
ReadPrec GetUsageForecast
Int -> ReadS GetUsageForecast
ReadS [GetUsageForecast]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUsageForecast]
$creadListPrec :: ReadPrec [GetUsageForecast]
readPrec :: ReadPrec GetUsageForecast
$creadPrec :: ReadPrec GetUsageForecast
readList :: ReadS [GetUsageForecast]
$creadList :: ReadS [GetUsageForecast]
readsPrec :: Int -> ReadS GetUsageForecast
$creadsPrec :: Int -> ReadS GetUsageForecast
Prelude.Read, Int -> GetUsageForecast -> ShowS
[GetUsageForecast] -> ShowS
GetUsageForecast -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUsageForecast] -> ShowS
$cshowList :: [GetUsageForecast] -> ShowS
show :: GetUsageForecast -> String
$cshow :: GetUsageForecast -> String
showsPrec :: Int -> GetUsageForecast -> ShowS
$cshowsPrec :: Int -> GetUsageForecast -> ShowS
Prelude.Show, forall x. Rep GetUsageForecast x -> GetUsageForecast
forall x. GetUsageForecast -> Rep GetUsageForecast x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetUsageForecast x -> GetUsageForecast
$cfrom :: forall x. GetUsageForecast -> Rep GetUsageForecast x
Prelude.Generic)

-- |
-- Create a value of 'GetUsageForecast' 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'', 'getUsageForecast_filter' - The filters that you want to use to filter your forecast. The
-- @GetUsageForecast@ API supports filtering by the following dimensions:
--
-- -   @AZ@
--
-- -   @INSTANCE_TYPE@
--
-- -   @LINKED_ACCOUNT@
--
-- -   @LINKED_ACCOUNT_NAME@
--
-- -   @OPERATION@
--
-- -   @PURCHASE_TYPE@
--
-- -   @REGION@
--
-- -   @SERVICE@
--
-- -   @USAGE_TYPE@
--
-- -   @USAGE_TYPE_GROUP@
--
-- -   @RECORD_TYPE@
--
-- -   @OPERATING_SYSTEM@
--
-- -   @TENANCY@
--
-- -   @SCOPE@
--
-- -   @PLATFORM@
--
-- -   @SUBSCRIPTION_ID@
--
-- -   @LEGAL_ENTITY_NAME@
--
-- -   @DEPLOYMENT_OPTION@
--
-- -   @DATABASE_ENGINE@
--
-- -   @INSTANCE_TYPE_FAMILY@
--
-- -   @BILLING_ENTITY@
--
-- -   @RESERVATION_ID@
--
-- -   @SAVINGS_PLAN_ARN@
--
-- 'predictionIntervalLevel', 'getUsageForecast_predictionIntervalLevel' - Amazon Web Services Cost Explorer always returns the mean forecast as a
-- single point. You can request a prediction interval around the mean by
-- specifying a confidence level. The higher the confidence level, the more
-- confident Cost Explorer is about the actual value falling in the
-- prediction interval. Higher confidence levels result in wider prediction
-- intervals.
--
-- 'timePeriod', 'getUsageForecast_timePeriod' - The start and end dates of the period that you want to retrieve usage
-- forecast for. The start date is included in the period, but the end date
-- isn\'t included in the period. 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@. The start date must be equal to or later than the current
-- date to avoid a validation error.
--
-- 'metric', 'getUsageForecast_metric' - Which metric Cost Explorer uses to create your forecast.
--
-- Valid values for a @GetUsageForecast@ call are the following:
--
-- -   USAGE_QUANTITY
--
-- -   NORMALIZED_USAGE_AMOUNT
--
-- 'granularity', 'getUsageForecast_granularity' - How granular you want the forecast to be. You can get 3 months of
-- @DAILY@ forecasts or 12 months of @MONTHLY@ forecasts.
--
-- The @GetUsageForecast@ operation supports only @DAILY@ and @MONTHLY@
-- granularities.
newGetUsageForecast ::
  -- | 'timePeriod'
  DateInterval ->
  -- | 'metric'
  Metric ->
  -- | 'granularity'
  Granularity ->
  GetUsageForecast
newGetUsageForecast :: DateInterval -> Metric -> Granularity -> GetUsageForecast
newGetUsageForecast
  DateInterval
pTimePeriod_
  Metric
pMetric_
  Granularity
pGranularity_ =
    GetUsageForecast'
      { $sel:filter':GetUsageForecast' :: Maybe Expression
filter' = forall a. Maybe a
Prelude.Nothing,
        $sel:predictionIntervalLevel:GetUsageForecast' :: Maybe Natural
predictionIntervalLevel = forall a. Maybe a
Prelude.Nothing,
        $sel:timePeriod:GetUsageForecast' :: DateInterval
timePeriod = DateInterval
pTimePeriod_,
        $sel:metric:GetUsageForecast' :: Metric
metric = Metric
pMetric_,
        $sel:granularity:GetUsageForecast' :: Granularity
granularity = Granularity
pGranularity_
      }

-- | The filters that you want to use to filter your forecast. The
-- @GetUsageForecast@ API supports filtering by the following dimensions:
--
-- -   @AZ@
--
-- -   @INSTANCE_TYPE@
--
-- -   @LINKED_ACCOUNT@
--
-- -   @LINKED_ACCOUNT_NAME@
--
-- -   @OPERATION@
--
-- -   @PURCHASE_TYPE@
--
-- -   @REGION@
--
-- -   @SERVICE@
--
-- -   @USAGE_TYPE@
--
-- -   @USAGE_TYPE_GROUP@
--
-- -   @RECORD_TYPE@
--
-- -   @OPERATING_SYSTEM@
--
-- -   @TENANCY@
--
-- -   @SCOPE@
--
-- -   @PLATFORM@
--
-- -   @SUBSCRIPTION_ID@
--
-- -   @LEGAL_ENTITY_NAME@
--
-- -   @DEPLOYMENT_OPTION@
--
-- -   @DATABASE_ENGINE@
--
-- -   @INSTANCE_TYPE_FAMILY@
--
-- -   @BILLING_ENTITY@
--
-- -   @RESERVATION_ID@
--
-- -   @SAVINGS_PLAN_ARN@
getUsageForecast_filter :: Lens.Lens' GetUsageForecast (Prelude.Maybe Expression)
getUsageForecast_filter :: Lens' GetUsageForecast (Maybe Expression)
getUsageForecast_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsageForecast' {Maybe Expression
filter' :: Maybe Expression
$sel:filter':GetUsageForecast' :: GetUsageForecast -> Maybe Expression
filter'} -> Maybe Expression
filter') (\s :: GetUsageForecast
s@GetUsageForecast' {} Maybe Expression
a -> GetUsageForecast
s {$sel:filter':GetUsageForecast' :: Maybe Expression
filter' = Maybe Expression
a} :: GetUsageForecast)

-- | Amazon Web Services Cost Explorer always returns the mean forecast as a
-- single point. You can request a prediction interval around the mean by
-- specifying a confidence level. The higher the confidence level, the more
-- confident Cost Explorer is about the actual value falling in the
-- prediction interval. Higher confidence levels result in wider prediction
-- intervals.
getUsageForecast_predictionIntervalLevel :: Lens.Lens' GetUsageForecast (Prelude.Maybe Prelude.Natural)
getUsageForecast_predictionIntervalLevel :: Lens' GetUsageForecast (Maybe Natural)
getUsageForecast_predictionIntervalLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsageForecast' {Maybe Natural
predictionIntervalLevel :: Maybe Natural
$sel:predictionIntervalLevel:GetUsageForecast' :: GetUsageForecast -> Maybe Natural
predictionIntervalLevel} -> Maybe Natural
predictionIntervalLevel) (\s :: GetUsageForecast
s@GetUsageForecast' {} Maybe Natural
a -> GetUsageForecast
s {$sel:predictionIntervalLevel:GetUsageForecast' :: Maybe Natural
predictionIntervalLevel = Maybe Natural
a} :: GetUsageForecast)

-- | The start and end dates of the period that you want to retrieve usage
-- forecast for. The start date is included in the period, but the end date
-- isn\'t included in the period. 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@. The start date must be equal to or later than the current
-- date to avoid a validation error.
getUsageForecast_timePeriod :: Lens.Lens' GetUsageForecast DateInterval
getUsageForecast_timePeriod :: Lens' GetUsageForecast DateInterval
getUsageForecast_timePeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsageForecast' {DateInterval
timePeriod :: DateInterval
$sel:timePeriod:GetUsageForecast' :: GetUsageForecast -> DateInterval
timePeriod} -> DateInterval
timePeriod) (\s :: GetUsageForecast
s@GetUsageForecast' {} DateInterval
a -> GetUsageForecast
s {$sel:timePeriod:GetUsageForecast' :: DateInterval
timePeriod = DateInterval
a} :: GetUsageForecast)

-- | Which metric Cost Explorer uses to create your forecast.
--
-- Valid values for a @GetUsageForecast@ call are the following:
--
-- -   USAGE_QUANTITY
--
-- -   NORMALIZED_USAGE_AMOUNT
getUsageForecast_metric :: Lens.Lens' GetUsageForecast Metric
getUsageForecast_metric :: Lens' GetUsageForecast Metric
getUsageForecast_metric = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsageForecast' {Metric
metric :: Metric
$sel:metric:GetUsageForecast' :: GetUsageForecast -> Metric
metric} -> Metric
metric) (\s :: GetUsageForecast
s@GetUsageForecast' {} Metric
a -> GetUsageForecast
s {$sel:metric:GetUsageForecast' :: Metric
metric = Metric
a} :: GetUsageForecast)

-- | How granular you want the forecast to be. You can get 3 months of
-- @DAILY@ forecasts or 12 months of @MONTHLY@ forecasts.
--
-- The @GetUsageForecast@ operation supports only @DAILY@ and @MONTHLY@
-- granularities.
getUsageForecast_granularity :: Lens.Lens' GetUsageForecast Granularity
getUsageForecast_granularity :: Lens' GetUsageForecast Granularity
getUsageForecast_granularity = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsageForecast' {Granularity
granularity :: Granularity
$sel:granularity:GetUsageForecast' :: GetUsageForecast -> Granularity
granularity} -> Granularity
granularity) (\s :: GetUsageForecast
s@GetUsageForecast' {} Granularity
a -> GetUsageForecast
s {$sel:granularity:GetUsageForecast' :: Granularity
granularity = Granularity
a} :: GetUsageForecast)

instance Core.AWSRequest GetUsageForecast where
  type
    AWSResponse GetUsageForecast =
      GetUsageForecastResponse
  request :: (Service -> Service)
-> GetUsageForecast -> Request GetUsageForecast
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 GetUsageForecast
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetUsageForecast)))
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 [ForecastResult]
-> Maybe MetricValue -> Int -> GetUsageForecastResponse
GetUsageForecastResponse'
            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
"ForecastResultsByTime"
                            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
"Total")
            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 GetUsageForecast where
  hashWithSalt :: Int -> GetUsageForecast -> Int
hashWithSalt Int
_salt GetUsageForecast' {Maybe Natural
Maybe Expression
DateInterval
Granularity
Metric
granularity :: Granularity
metric :: Metric
timePeriod :: DateInterval
predictionIntervalLevel :: Maybe Natural
filter' :: Maybe Expression
$sel:granularity:GetUsageForecast' :: GetUsageForecast -> Granularity
$sel:metric:GetUsageForecast' :: GetUsageForecast -> Metric
$sel:timePeriod:GetUsageForecast' :: GetUsageForecast -> DateInterval
$sel:predictionIntervalLevel:GetUsageForecast' :: GetUsageForecast -> Maybe Natural
$sel:filter':GetUsageForecast' :: GetUsageForecast -> 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 Natural
predictionIntervalLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DateInterval
timePeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Metric
metric
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Granularity
granularity

instance Prelude.NFData GetUsageForecast where
  rnf :: GetUsageForecast -> ()
rnf GetUsageForecast' {Maybe Natural
Maybe Expression
DateInterval
Granularity
Metric
granularity :: Granularity
metric :: Metric
timePeriod :: DateInterval
predictionIntervalLevel :: Maybe Natural
filter' :: Maybe Expression
$sel:granularity:GetUsageForecast' :: GetUsageForecast -> Granularity
$sel:metric:GetUsageForecast' :: GetUsageForecast -> Metric
$sel:timePeriod:GetUsageForecast' :: GetUsageForecast -> DateInterval
$sel:predictionIntervalLevel:GetUsageForecast' :: GetUsageForecast -> Maybe Natural
$sel:filter':GetUsageForecast' :: GetUsageForecast -> 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 Natural
predictionIntervalLevel
      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 Metric
metric
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Granularity
granularity

instance Data.ToHeaders GetUsageForecast where
  toHeaders :: GetUsageForecast -> 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.GetUsageForecast" ::
                          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 GetUsageForecast where
  toJSON :: GetUsageForecast -> Value
toJSON GetUsageForecast' {Maybe Natural
Maybe Expression
DateInterval
Granularity
Metric
granularity :: Granularity
metric :: Metric
timePeriod :: DateInterval
predictionIntervalLevel :: Maybe Natural
filter' :: Maybe Expression
$sel:granularity:GetUsageForecast' :: GetUsageForecast -> Granularity
$sel:metric:GetUsageForecast' :: GetUsageForecast -> Metric
$sel:timePeriod:GetUsageForecast' :: GetUsageForecast -> DateInterval
$sel:predictionIntervalLevel:GetUsageForecast' :: GetUsageForecast -> Maybe Natural
$sel:filter':GetUsageForecast' :: GetUsageForecast -> 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
"PredictionIntervalLevel" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
predictionIntervalLevel,
            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
"Metric" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Metric
metric),
            forall a. a -> Maybe a
Prelude.Just (Key
"Granularity" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Granularity
granularity)
          ]
      )

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

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

-- | /See:/ 'newGetUsageForecastResponse' smart constructor.
data GetUsageForecastResponse = GetUsageForecastResponse'
  { -- | The forecasts for your query, in order. For @DAILY@ forecasts, this is a
    -- list of days. For @MONTHLY@ forecasts, this is a list of months.
    GetUsageForecastResponse -> Maybe [ForecastResult]
forecastResultsByTime :: Prelude.Maybe [ForecastResult],
    -- | How much you\'re forecasted to use over the forecast period.
    GetUsageForecastResponse -> Maybe MetricValue
total :: Prelude.Maybe MetricValue,
    -- | The response's http status code.
    GetUsageForecastResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetUsageForecastResponse -> GetUsageForecastResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUsageForecastResponse -> GetUsageForecastResponse -> Bool
$c/= :: GetUsageForecastResponse -> GetUsageForecastResponse -> Bool
== :: GetUsageForecastResponse -> GetUsageForecastResponse -> Bool
$c== :: GetUsageForecastResponse -> GetUsageForecastResponse -> Bool
Prelude.Eq, ReadPrec [GetUsageForecastResponse]
ReadPrec GetUsageForecastResponse
Int -> ReadS GetUsageForecastResponse
ReadS [GetUsageForecastResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUsageForecastResponse]
$creadListPrec :: ReadPrec [GetUsageForecastResponse]
readPrec :: ReadPrec GetUsageForecastResponse
$creadPrec :: ReadPrec GetUsageForecastResponse
readList :: ReadS [GetUsageForecastResponse]
$creadList :: ReadS [GetUsageForecastResponse]
readsPrec :: Int -> ReadS GetUsageForecastResponse
$creadsPrec :: Int -> ReadS GetUsageForecastResponse
Prelude.Read, Int -> GetUsageForecastResponse -> ShowS
[GetUsageForecastResponse] -> ShowS
GetUsageForecastResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUsageForecastResponse] -> ShowS
$cshowList :: [GetUsageForecastResponse] -> ShowS
show :: GetUsageForecastResponse -> String
$cshow :: GetUsageForecastResponse -> String
showsPrec :: Int -> GetUsageForecastResponse -> ShowS
$cshowsPrec :: Int -> GetUsageForecastResponse -> ShowS
Prelude.Show, forall x.
Rep GetUsageForecastResponse x -> GetUsageForecastResponse
forall x.
GetUsageForecastResponse -> Rep GetUsageForecastResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetUsageForecastResponse x -> GetUsageForecastResponse
$cfrom :: forall x.
GetUsageForecastResponse -> Rep GetUsageForecastResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetUsageForecastResponse' 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:
--
-- 'forecastResultsByTime', 'getUsageForecastResponse_forecastResultsByTime' - The forecasts for your query, in order. For @DAILY@ forecasts, this is a
-- list of days. For @MONTHLY@ forecasts, this is a list of months.
--
-- 'total', 'getUsageForecastResponse_total' - How much you\'re forecasted to use over the forecast period.
--
-- 'httpStatus', 'getUsageForecastResponse_httpStatus' - The response's http status code.
newGetUsageForecastResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetUsageForecastResponse
newGetUsageForecastResponse :: Int -> GetUsageForecastResponse
newGetUsageForecastResponse Int
pHttpStatus_ =
  GetUsageForecastResponse'
    { $sel:forecastResultsByTime:GetUsageForecastResponse' :: Maybe [ForecastResult]
forecastResultsByTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:total:GetUsageForecastResponse' :: Maybe MetricValue
total = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetUsageForecastResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The forecasts for your query, in order. For @DAILY@ forecasts, this is a
-- list of days. For @MONTHLY@ forecasts, this is a list of months.
getUsageForecastResponse_forecastResultsByTime :: Lens.Lens' GetUsageForecastResponse (Prelude.Maybe [ForecastResult])
getUsageForecastResponse_forecastResultsByTime :: Lens' GetUsageForecastResponse (Maybe [ForecastResult])
getUsageForecastResponse_forecastResultsByTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsageForecastResponse' {Maybe [ForecastResult]
forecastResultsByTime :: Maybe [ForecastResult]
$sel:forecastResultsByTime:GetUsageForecastResponse' :: GetUsageForecastResponse -> Maybe [ForecastResult]
forecastResultsByTime} -> Maybe [ForecastResult]
forecastResultsByTime) (\s :: GetUsageForecastResponse
s@GetUsageForecastResponse' {} Maybe [ForecastResult]
a -> GetUsageForecastResponse
s {$sel:forecastResultsByTime:GetUsageForecastResponse' :: Maybe [ForecastResult]
forecastResultsByTime = Maybe [ForecastResult]
a} :: GetUsageForecastResponse) 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

-- | How much you\'re forecasted to use over the forecast period.
getUsageForecastResponse_total :: Lens.Lens' GetUsageForecastResponse (Prelude.Maybe MetricValue)
getUsageForecastResponse_total :: Lens' GetUsageForecastResponse (Maybe MetricValue)
getUsageForecastResponse_total = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUsageForecastResponse' {Maybe MetricValue
total :: Maybe MetricValue
$sel:total:GetUsageForecastResponse' :: GetUsageForecastResponse -> Maybe MetricValue
total} -> Maybe MetricValue
total) (\s :: GetUsageForecastResponse
s@GetUsageForecastResponse' {} Maybe MetricValue
a -> GetUsageForecastResponse
s {$sel:total:GetUsageForecastResponse' :: Maybe MetricValue
total = Maybe MetricValue
a} :: GetUsageForecastResponse)

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

instance Prelude.NFData GetUsageForecastResponse where
  rnf :: GetUsageForecastResponse -> ()
rnf GetUsageForecastResponse' {Int
Maybe [ForecastResult]
Maybe MetricValue
httpStatus :: Int
total :: Maybe MetricValue
forecastResultsByTime :: Maybe [ForecastResult]
$sel:httpStatus:GetUsageForecastResponse' :: GetUsageForecastResponse -> Int
$sel:total:GetUsageForecastResponse' :: GetUsageForecastResponse -> Maybe MetricValue
$sel:forecastResultsByTime:GetUsageForecastResponse' :: GetUsageForecastResponse -> Maybe [ForecastResult]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ForecastResult]
forecastResultsByTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MetricValue
total
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus