{-# 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.AutoScalingPlans.GetScalingPlanResourceForecastData
-- 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 the forecast data for a scalable resource.
--
-- Capacity forecasts are represented as predicted values, or data points,
-- that are calculated using historical data points from a specified
-- CloudWatch load metric. Data points are available for up to 56 days.
module Amazonka.AutoScalingPlans.GetScalingPlanResourceForecastData
  ( -- * Creating a Request
    GetScalingPlanResourceForecastData (..),
    newGetScalingPlanResourceForecastData,

    -- * Request Lenses
    getScalingPlanResourceForecastData_scalingPlanName,
    getScalingPlanResourceForecastData_scalingPlanVersion,
    getScalingPlanResourceForecastData_serviceNamespace,
    getScalingPlanResourceForecastData_resourceId,
    getScalingPlanResourceForecastData_scalableDimension,
    getScalingPlanResourceForecastData_forecastDataType,
    getScalingPlanResourceForecastData_startTime,
    getScalingPlanResourceForecastData_endTime,

    -- * Destructuring the Response
    GetScalingPlanResourceForecastDataResponse (..),
    newGetScalingPlanResourceForecastDataResponse,

    -- * Response Lenses
    getScalingPlanResourceForecastDataResponse_httpStatus,
    getScalingPlanResourceForecastDataResponse_datapoints,
  )
where

import Amazonka.AutoScalingPlans.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetScalingPlanResourceForecastData' smart constructor.
data GetScalingPlanResourceForecastData = GetScalingPlanResourceForecastData'
  { -- | The name of the scaling plan.
    GetScalingPlanResourceForecastData -> Text
scalingPlanName :: Prelude.Text,
    -- | The version number of the scaling plan. Currently, the only valid value
    -- is @1@.
    GetScalingPlanResourceForecastData -> Integer
scalingPlanVersion :: Prelude.Integer,
    -- | The namespace of the AWS service. The only valid value is @autoscaling@.
    GetScalingPlanResourceForecastData -> ServiceNamespace
serviceNamespace :: ServiceNamespace,
    -- | The ID of the resource. This string consists of a prefix
    -- (@autoScalingGroup@) followed by the name of a specified Auto Scaling
    -- group (@my-asg@). Example: @autoScalingGroup\/my-asg@.
    GetScalingPlanResourceForecastData -> Text
resourceId :: Prelude.Text,
    -- | The scalable dimension for the resource. The only valid value is
    -- @autoscaling:autoScalingGroup:DesiredCapacity@.
    GetScalingPlanResourceForecastData -> ScalableDimension
scalableDimension :: ScalableDimension,
    -- | The type of forecast data to get.
    --
    -- -   @LoadForecast@: The load metric forecast.
    --
    -- -   @CapacityForecast@: The capacity forecast.
    --
    -- -   @ScheduledActionMinCapacity@: The minimum capacity for each
    --     scheduled scaling action. This data is calculated as the larger of
    --     two values: the capacity forecast or the minimum capacity in the
    --     scaling instruction.
    --
    -- -   @ScheduledActionMaxCapacity@: The maximum capacity for each
    --     scheduled scaling action. The calculation used is determined by the
    --     predictive scaling maximum capacity behavior setting in the scaling
    --     instruction.
    GetScalingPlanResourceForecastData -> ForecastDataType
forecastDataType :: ForecastDataType,
    -- | The inclusive start time of the time range for the forecast data to get.
    -- The date and time can be at most 56 days before the current date and
    -- time.
    GetScalingPlanResourceForecastData -> POSIX
startTime :: Data.POSIX,
    -- | The exclusive end time of the time range for the forecast data to get.
    -- The maximum time duration between the start and end time is seven days.
    --
    -- Although this parameter can accept a date and time that is more than two
    -- days in the future, the availability of forecast data has limits. AWS
    -- Auto Scaling only issues forecasts for periods of two days in advance.
    GetScalingPlanResourceForecastData -> POSIX
endTime :: Data.POSIX
  }
  deriving (GetScalingPlanResourceForecastData
-> GetScalingPlanResourceForecastData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetScalingPlanResourceForecastData
-> GetScalingPlanResourceForecastData -> Bool
$c/= :: GetScalingPlanResourceForecastData
-> GetScalingPlanResourceForecastData -> Bool
== :: GetScalingPlanResourceForecastData
-> GetScalingPlanResourceForecastData -> Bool
$c== :: GetScalingPlanResourceForecastData
-> GetScalingPlanResourceForecastData -> Bool
Prelude.Eq, ReadPrec [GetScalingPlanResourceForecastData]
ReadPrec GetScalingPlanResourceForecastData
Int -> ReadS GetScalingPlanResourceForecastData
ReadS [GetScalingPlanResourceForecastData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetScalingPlanResourceForecastData]
$creadListPrec :: ReadPrec [GetScalingPlanResourceForecastData]
readPrec :: ReadPrec GetScalingPlanResourceForecastData
$creadPrec :: ReadPrec GetScalingPlanResourceForecastData
readList :: ReadS [GetScalingPlanResourceForecastData]
$creadList :: ReadS [GetScalingPlanResourceForecastData]
readsPrec :: Int -> ReadS GetScalingPlanResourceForecastData
$creadsPrec :: Int -> ReadS GetScalingPlanResourceForecastData
Prelude.Read, Int -> GetScalingPlanResourceForecastData -> ShowS
[GetScalingPlanResourceForecastData] -> ShowS
GetScalingPlanResourceForecastData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetScalingPlanResourceForecastData] -> ShowS
$cshowList :: [GetScalingPlanResourceForecastData] -> ShowS
show :: GetScalingPlanResourceForecastData -> String
$cshow :: GetScalingPlanResourceForecastData -> String
showsPrec :: Int -> GetScalingPlanResourceForecastData -> ShowS
$cshowsPrec :: Int -> GetScalingPlanResourceForecastData -> ShowS
Prelude.Show, forall x.
Rep GetScalingPlanResourceForecastData x
-> GetScalingPlanResourceForecastData
forall x.
GetScalingPlanResourceForecastData
-> Rep GetScalingPlanResourceForecastData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetScalingPlanResourceForecastData x
-> GetScalingPlanResourceForecastData
$cfrom :: forall x.
GetScalingPlanResourceForecastData
-> Rep GetScalingPlanResourceForecastData x
Prelude.Generic)

-- |
-- Create a value of 'GetScalingPlanResourceForecastData' 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:
--
-- 'scalingPlanName', 'getScalingPlanResourceForecastData_scalingPlanName' - The name of the scaling plan.
--
-- 'scalingPlanVersion', 'getScalingPlanResourceForecastData_scalingPlanVersion' - The version number of the scaling plan. Currently, the only valid value
-- is @1@.
--
-- 'serviceNamespace', 'getScalingPlanResourceForecastData_serviceNamespace' - The namespace of the AWS service. The only valid value is @autoscaling@.
--
-- 'resourceId', 'getScalingPlanResourceForecastData_resourceId' - The ID of the resource. This string consists of a prefix
-- (@autoScalingGroup@) followed by the name of a specified Auto Scaling
-- group (@my-asg@). Example: @autoScalingGroup\/my-asg@.
--
-- 'scalableDimension', 'getScalingPlanResourceForecastData_scalableDimension' - The scalable dimension for the resource. The only valid value is
-- @autoscaling:autoScalingGroup:DesiredCapacity@.
--
-- 'forecastDataType', 'getScalingPlanResourceForecastData_forecastDataType' - The type of forecast data to get.
--
-- -   @LoadForecast@: The load metric forecast.
--
-- -   @CapacityForecast@: The capacity forecast.
--
-- -   @ScheduledActionMinCapacity@: The minimum capacity for each
--     scheduled scaling action. This data is calculated as the larger of
--     two values: the capacity forecast or the minimum capacity in the
--     scaling instruction.
--
-- -   @ScheduledActionMaxCapacity@: The maximum capacity for each
--     scheduled scaling action. The calculation used is determined by the
--     predictive scaling maximum capacity behavior setting in the scaling
--     instruction.
--
-- 'startTime', 'getScalingPlanResourceForecastData_startTime' - The inclusive start time of the time range for the forecast data to get.
-- The date and time can be at most 56 days before the current date and
-- time.
--
-- 'endTime', 'getScalingPlanResourceForecastData_endTime' - The exclusive end time of the time range for the forecast data to get.
-- The maximum time duration between the start and end time is seven days.
--
-- Although this parameter can accept a date and time that is more than two
-- days in the future, the availability of forecast data has limits. AWS
-- Auto Scaling only issues forecasts for periods of two days in advance.
newGetScalingPlanResourceForecastData ::
  -- | 'scalingPlanName'
  Prelude.Text ->
  -- | 'scalingPlanVersion'
  Prelude.Integer ->
  -- | 'serviceNamespace'
  ServiceNamespace ->
  -- | 'resourceId'
  Prelude.Text ->
  -- | 'scalableDimension'
  ScalableDimension ->
  -- | 'forecastDataType'
  ForecastDataType ->
  -- | 'startTime'
  Prelude.UTCTime ->
  -- | 'endTime'
  Prelude.UTCTime ->
  GetScalingPlanResourceForecastData
newGetScalingPlanResourceForecastData :: Text
-> Integer
-> ServiceNamespace
-> Text
-> ScalableDimension
-> ForecastDataType
-> UTCTime
-> UTCTime
-> GetScalingPlanResourceForecastData
newGetScalingPlanResourceForecastData
  Text
pScalingPlanName_
  Integer
pScalingPlanVersion_
  ServiceNamespace
pServiceNamespace_
  Text
pResourceId_
  ScalableDimension
pScalableDimension_
  ForecastDataType
pForecastDataType_
  UTCTime
pStartTime_
  UTCTime
pEndTime_ =
    GetScalingPlanResourceForecastData'
      { $sel:scalingPlanName:GetScalingPlanResourceForecastData' :: Text
scalingPlanName =
          Text
pScalingPlanName_,
        $sel:scalingPlanVersion:GetScalingPlanResourceForecastData' :: Integer
scalingPlanVersion =
          Integer
pScalingPlanVersion_,
        $sel:serviceNamespace:GetScalingPlanResourceForecastData' :: ServiceNamespace
serviceNamespace = ServiceNamespace
pServiceNamespace_,
        $sel:resourceId:GetScalingPlanResourceForecastData' :: Text
resourceId = Text
pResourceId_,
        $sel:scalableDimension:GetScalingPlanResourceForecastData' :: ScalableDimension
scalableDimension = ScalableDimension
pScalableDimension_,
        $sel:forecastDataType:GetScalingPlanResourceForecastData' :: ForecastDataType
forecastDataType = ForecastDataType
pForecastDataType_,
        $sel:startTime:GetScalingPlanResourceForecastData' :: POSIX
startTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_,
        $sel:endTime:GetScalingPlanResourceForecastData' :: POSIX
endTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pEndTime_
      }

-- | The name of the scaling plan.
getScalingPlanResourceForecastData_scalingPlanName :: Lens.Lens' GetScalingPlanResourceForecastData Prelude.Text
getScalingPlanResourceForecastData_scalingPlanName :: Lens' GetScalingPlanResourceForecastData Text
getScalingPlanResourceForecastData_scalingPlanName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastData' {Text
scalingPlanName :: Text
$sel:scalingPlanName:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Text
scalingPlanName} -> Text
scalingPlanName) (\s :: GetScalingPlanResourceForecastData
s@GetScalingPlanResourceForecastData' {} Text
a -> GetScalingPlanResourceForecastData
s {$sel:scalingPlanName:GetScalingPlanResourceForecastData' :: Text
scalingPlanName = Text
a} :: GetScalingPlanResourceForecastData)

-- | The version number of the scaling plan. Currently, the only valid value
-- is @1@.
getScalingPlanResourceForecastData_scalingPlanVersion :: Lens.Lens' GetScalingPlanResourceForecastData Prelude.Integer
getScalingPlanResourceForecastData_scalingPlanVersion :: Lens' GetScalingPlanResourceForecastData Integer
getScalingPlanResourceForecastData_scalingPlanVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastData' {Integer
scalingPlanVersion :: Integer
$sel:scalingPlanVersion:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Integer
scalingPlanVersion} -> Integer
scalingPlanVersion) (\s :: GetScalingPlanResourceForecastData
s@GetScalingPlanResourceForecastData' {} Integer
a -> GetScalingPlanResourceForecastData
s {$sel:scalingPlanVersion:GetScalingPlanResourceForecastData' :: Integer
scalingPlanVersion = Integer
a} :: GetScalingPlanResourceForecastData)

-- | The namespace of the AWS service. The only valid value is @autoscaling@.
getScalingPlanResourceForecastData_serviceNamespace :: Lens.Lens' GetScalingPlanResourceForecastData ServiceNamespace
getScalingPlanResourceForecastData_serviceNamespace :: Lens' GetScalingPlanResourceForecastData ServiceNamespace
getScalingPlanResourceForecastData_serviceNamespace = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastData' {ServiceNamespace
serviceNamespace :: ServiceNamespace
$sel:serviceNamespace:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ServiceNamespace
serviceNamespace} -> ServiceNamespace
serviceNamespace) (\s :: GetScalingPlanResourceForecastData
s@GetScalingPlanResourceForecastData' {} ServiceNamespace
a -> GetScalingPlanResourceForecastData
s {$sel:serviceNamespace:GetScalingPlanResourceForecastData' :: ServiceNamespace
serviceNamespace = ServiceNamespace
a} :: GetScalingPlanResourceForecastData)

-- | The ID of the resource. This string consists of a prefix
-- (@autoScalingGroup@) followed by the name of a specified Auto Scaling
-- group (@my-asg@). Example: @autoScalingGroup\/my-asg@.
getScalingPlanResourceForecastData_resourceId :: Lens.Lens' GetScalingPlanResourceForecastData Prelude.Text
getScalingPlanResourceForecastData_resourceId :: Lens' GetScalingPlanResourceForecastData Text
getScalingPlanResourceForecastData_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastData' {Text
resourceId :: Text
$sel:resourceId:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Text
resourceId} -> Text
resourceId) (\s :: GetScalingPlanResourceForecastData
s@GetScalingPlanResourceForecastData' {} Text
a -> GetScalingPlanResourceForecastData
s {$sel:resourceId:GetScalingPlanResourceForecastData' :: Text
resourceId = Text
a} :: GetScalingPlanResourceForecastData)

-- | The scalable dimension for the resource. The only valid value is
-- @autoscaling:autoScalingGroup:DesiredCapacity@.
getScalingPlanResourceForecastData_scalableDimension :: Lens.Lens' GetScalingPlanResourceForecastData ScalableDimension
getScalingPlanResourceForecastData_scalableDimension :: Lens' GetScalingPlanResourceForecastData ScalableDimension
getScalingPlanResourceForecastData_scalableDimension = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastData' {ScalableDimension
scalableDimension :: ScalableDimension
$sel:scalableDimension:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ScalableDimension
scalableDimension} -> ScalableDimension
scalableDimension) (\s :: GetScalingPlanResourceForecastData
s@GetScalingPlanResourceForecastData' {} ScalableDimension
a -> GetScalingPlanResourceForecastData
s {$sel:scalableDimension:GetScalingPlanResourceForecastData' :: ScalableDimension
scalableDimension = ScalableDimension
a} :: GetScalingPlanResourceForecastData)

-- | The type of forecast data to get.
--
-- -   @LoadForecast@: The load metric forecast.
--
-- -   @CapacityForecast@: The capacity forecast.
--
-- -   @ScheduledActionMinCapacity@: The minimum capacity for each
--     scheduled scaling action. This data is calculated as the larger of
--     two values: the capacity forecast or the minimum capacity in the
--     scaling instruction.
--
-- -   @ScheduledActionMaxCapacity@: The maximum capacity for each
--     scheduled scaling action. The calculation used is determined by the
--     predictive scaling maximum capacity behavior setting in the scaling
--     instruction.
getScalingPlanResourceForecastData_forecastDataType :: Lens.Lens' GetScalingPlanResourceForecastData ForecastDataType
getScalingPlanResourceForecastData_forecastDataType :: Lens' GetScalingPlanResourceForecastData ForecastDataType
getScalingPlanResourceForecastData_forecastDataType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastData' {ForecastDataType
forecastDataType :: ForecastDataType
$sel:forecastDataType:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ForecastDataType
forecastDataType} -> ForecastDataType
forecastDataType) (\s :: GetScalingPlanResourceForecastData
s@GetScalingPlanResourceForecastData' {} ForecastDataType
a -> GetScalingPlanResourceForecastData
s {$sel:forecastDataType:GetScalingPlanResourceForecastData' :: ForecastDataType
forecastDataType = ForecastDataType
a} :: GetScalingPlanResourceForecastData)

-- | The inclusive start time of the time range for the forecast data to get.
-- The date and time can be at most 56 days before the current date and
-- time.
getScalingPlanResourceForecastData_startTime :: Lens.Lens' GetScalingPlanResourceForecastData Prelude.UTCTime
getScalingPlanResourceForecastData_startTime :: Lens' GetScalingPlanResourceForecastData UTCTime
getScalingPlanResourceForecastData_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastData' {POSIX
startTime :: POSIX
$sel:startTime:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> POSIX
startTime} -> POSIX
startTime) (\s :: GetScalingPlanResourceForecastData
s@GetScalingPlanResourceForecastData' {} POSIX
a -> GetScalingPlanResourceForecastData
s {$sel:startTime:GetScalingPlanResourceForecastData' :: POSIX
startTime = POSIX
a} :: GetScalingPlanResourceForecastData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The exclusive end time of the time range for the forecast data to get.
-- The maximum time duration between the start and end time is seven days.
--
-- Although this parameter can accept a date and time that is more than two
-- days in the future, the availability of forecast data has limits. AWS
-- Auto Scaling only issues forecasts for periods of two days in advance.
getScalingPlanResourceForecastData_endTime :: Lens.Lens' GetScalingPlanResourceForecastData Prelude.UTCTime
getScalingPlanResourceForecastData_endTime :: Lens' GetScalingPlanResourceForecastData UTCTime
getScalingPlanResourceForecastData_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastData' {POSIX
endTime :: POSIX
$sel:endTime:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> POSIX
endTime} -> POSIX
endTime) (\s :: GetScalingPlanResourceForecastData
s@GetScalingPlanResourceForecastData' {} POSIX
a -> GetScalingPlanResourceForecastData
s {$sel:endTime:GetScalingPlanResourceForecastData' :: POSIX
endTime = POSIX
a} :: GetScalingPlanResourceForecastData) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance
  Core.AWSRequest
    GetScalingPlanResourceForecastData
  where
  type
    AWSResponse GetScalingPlanResourceForecastData =
      GetScalingPlanResourceForecastDataResponse
  request :: (Service -> Service)
-> GetScalingPlanResourceForecastData
-> Request GetScalingPlanResourceForecastData
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 GetScalingPlanResourceForecastData
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse GetScalingPlanResourceForecastData)))
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 ->
          Int -> [Datapoint] -> GetScalingPlanResourceForecastDataResponse
GetScalingPlanResourceForecastDataResponse'
            forall (f :: * -> *) a b. Functor 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))
            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
"Datapoints" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance
  Prelude.Hashable
    GetScalingPlanResourceForecastData
  where
  hashWithSalt :: Int -> GetScalingPlanResourceForecastData -> Int
hashWithSalt
    Int
_salt
    GetScalingPlanResourceForecastData' {Integer
Text
POSIX
ForecastDataType
ScalableDimension
ServiceNamespace
endTime :: POSIX
startTime :: POSIX
forecastDataType :: ForecastDataType
scalableDimension :: ScalableDimension
resourceId :: Text
serviceNamespace :: ServiceNamespace
scalingPlanVersion :: Integer
scalingPlanName :: Text
$sel:endTime:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> POSIX
$sel:startTime:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> POSIX
$sel:forecastDataType:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ForecastDataType
$sel:scalableDimension:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ScalableDimension
$sel:resourceId:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Text
$sel:serviceNamespace:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ServiceNamespace
$sel:scalingPlanVersion:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Integer
$sel:scalingPlanName:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
scalingPlanName
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Integer
scalingPlanVersion
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ServiceNamespace
serviceNamespace
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ScalableDimension
scalableDimension
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ForecastDataType
forecastDataType
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
startTime
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
endTime

instance
  Prelude.NFData
    GetScalingPlanResourceForecastData
  where
  rnf :: GetScalingPlanResourceForecastData -> ()
rnf GetScalingPlanResourceForecastData' {Integer
Text
POSIX
ForecastDataType
ScalableDimension
ServiceNamespace
endTime :: POSIX
startTime :: POSIX
forecastDataType :: ForecastDataType
scalableDimension :: ScalableDimension
resourceId :: Text
serviceNamespace :: ServiceNamespace
scalingPlanVersion :: Integer
scalingPlanName :: Text
$sel:endTime:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> POSIX
$sel:startTime:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> POSIX
$sel:forecastDataType:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ForecastDataType
$sel:scalableDimension:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ScalableDimension
$sel:resourceId:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Text
$sel:serviceNamespace:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ServiceNamespace
$sel:scalingPlanVersion:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Integer
$sel:scalingPlanName:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
scalingPlanName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
scalingPlanVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ServiceNamespace
serviceNamespace
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ScalableDimension
scalableDimension
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ForecastDataType
forecastDataType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
endTime

instance
  Data.ToHeaders
    GetScalingPlanResourceForecastData
  where
  toHeaders :: GetScalingPlanResourceForecastData -> 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
"AnyScaleScalingPlannerFrontendService.GetScalingPlanResourceForecastData" ::
                          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
    GetScalingPlanResourceForecastData
  where
  toJSON :: GetScalingPlanResourceForecastData -> Value
toJSON GetScalingPlanResourceForecastData' {Integer
Text
POSIX
ForecastDataType
ScalableDimension
ServiceNamespace
endTime :: POSIX
startTime :: POSIX
forecastDataType :: ForecastDataType
scalableDimension :: ScalableDimension
resourceId :: Text
serviceNamespace :: ServiceNamespace
scalingPlanVersion :: Integer
scalingPlanName :: Text
$sel:endTime:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> POSIX
$sel:startTime:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> POSIX
$sel:forecastDataType:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ForecastDataType
$sel:scalableDimension:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ScalableDimension
$sel:resourceId:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Text
$sel:serviceNamespace:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> ServiceNamespace
$sel:scalingPlanVersion:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Integer
$sel:scalingPlanName:GetScalingPlanResourceForecastData' :: GetScalingPlanResourceForecastData -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"ScalingPlanName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
scalingPlanName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ScalingPlanVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Integer
scalingPlanVersion),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ServiceNamespace" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ServiceNamespace
serviceNamespace),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ScalableDimension" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ScalableDimension
scalableDimension),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ForecastDataType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ForecastDataType
forecastDataType),
            forall a. a -> Maybe a
Prelude.Just (Key
"StartTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
startTime),
            forall a. a -> Maybe a
Prelude.Just (Key
"EndTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
endTime)
          ]
      )

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

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

-- | /See:/ 'newGetScalingPlanResourceForecastDataResponse' smart constructor.
data GetScalingPlanResourceForecastDataResponse = GetScalingPlanResourceForecastDataResponse'
  { -- | The response's http status code.
    GetScalingPlanResourceForecastDataResponse -> Int
httpStatus :: Prelude.Int,
    -- | The data points to return.
    GetScalingPlanResourceForecastDataResponse -> [Datapoint]
datapoints :: [Datapoint]
  }
  deriving (GetScalingPlanResourceForecastDataResponse
-> GetScalingPlanResourceForecastDataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetScalingPlanResourceForecastDataResponse
-> GetScalingPlanResourceForecastDataResponse -> Bool
$c/= :: GetScalingPlanResourceForecastDataResponse
-> GetScalingPlanResourceForecastDataResponse -> Bool
== :: GetScalingPlanResourceForecastDataResponse
-> GetScalingPlanResourceForecastDataResponse -> Bool
$c== :: GetScalingPlanResourceForecastDataResponse
-> GetScalingPlanResourceForecastDataResponse -> Bool
Prelude.Eq, ReadPrec [GetScalingPlanResourceForecastDataResponse]
ReadPrec GetScalingPlanResourceForecastDataResponse
Int -> ReadS GetScalingPlanResourceForecastDataResponse
ReadS [GetScalingPlanResourceForecastDataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetScalingPlanResourceForecastDataResponse]
$creadListPrec :: ReadPrec [GetScalingPlanResourceForecastDataResponse]
readPrec :: ReadPrec GetScalingPlanResourceForecastDataResponse
$creadPrec :: ReadPrec GetScalingPlanResourceForecastDataResponse
readList :: ReadS [GetScalingPlanResourceForecastDataResponse]
$creadList :: ReadS [GetScalingPlanResourceForecastDataResponse]
readsPrec :: Int -> ReadS GetScalingPlanResourceForecastDataResponse
$creadsPrec :: Int -> ReadS GetScalingPlanResourceForecastDataResponse
Prelude.Read, Int -> GetScalingPlanResourceForecastDataResponse -> ShowS
[GetScalingPlanResourceForecastDataResponse] -> ShowS
GetScalingPlanResourceForecastDataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetScalingPlanResourceForecastDataResponse] -> ShowS
$cshowList :: [GetScalingPlanResourceForecastDataResponse] -> ShowS
show :: GetScalingPlanResourceForecastDataResponse -> String
$cshow :: GetScalingPlanResourceForecastDataResponse -> String
showsPrec :: Int -> GetScalingPlanResourceForecastDataResponse -> ShowS
$cshowsPrec :: Int -> GetScalingPlanResourceForecastDataResponse -> ShowS
Prelude.Show, forall x.
Rep GetScalingPlanResourceForecastDataResponse x
-> GetScalingPlanResourceForecastDataResponse
forall x.
GetScalingPlanResourceForecastDataResponse
-> Rep GetScalingPlanResourceForecastDataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetScalingPlanResourceForecastDataResponse x
-> GetScalingPlanResourceForecastDataResponse
$cfrom :: forall x.
GetScalingPlanResourceForecastDataResponse
-> Rep GetScalingPlanResourceForecastDataResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetScalingPlanResourceForecastDataResponse' 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:
--
-- 'httpStatus', 'getScalingPlanResourceForecastDataResponse_httpStatus' - The response's http status code.
--
-- 'datapoints', 'getScalingPlanResourceForecastDataResponse_datapoints' - The data points to return.
newGetScalingPlanResourceForecastDataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetScalingPlanResourceForecastDataResponse
newGetScalingPlanResourceForecastDataResponse :: Int -> GetScalingPlanResourceForecastDataResponse
newGetScalingPlanResourceForecastDataResponse
  Int
pHttpStatus_ =
    GetScalingPlanResourceForecastDataResponse'
      { $sel:httpStatus:GetScalingPlanResourceForecastDataResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:datapoints:GetScalingPlanResourceForecastDataResponse' :: [Datapoint]
datapoints = forall a. Monoid a => a
Prelude.mempty
      }

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

-- | The data points to return.
getScalingPlanResourceForecastDataResponse_datapoints :: Lens.Lens' GetScalingPlanResourceForecastDataResponse [Datapoint]
getScalingPlanResourceForecastDataResponse_datapoints :: Lens' GetScalingPlanResourceForecastDataResponse [Datapoint]
getScalingPlanResourceForecastDataResponse_datapoints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetScalingPlanResourceForecastDataResponse' {[Datapoint]
datapoints :: [Datapoint]
$sel:datapoints:GetScalingPlanResourceForecastDataResponse' :: GetScalingPlanResourceForecastDataResponse -> [Datapoint]
datapoints} -> [Datapoint]
datapoints) (\s :: GetScalingPlanResourceForecastDataResponse
s@GetScalingPlanResourceForecastDataResponse' {} [Datapoint]
a -> GetScalingPlanResourceForecastDataResponse
s {$sel:datapoints:GetScalingPlanResourceForecastDataResponse' :: [Datapoint]
datapoints = [Datapoint]
a} :: GetScalingPlanResourceForecastDataResponse) 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
  Prelude.NFData
    GetScalingPlanResourceForecastDataResponse
  where
  rnf :: GetScalingPlanResourceForecastDataResponse -> ()
rnf GetScalingPlanResourceForecastDataResponse' {Int
[Datapoint]
datapoints :: [Datapoint]
httpStatus :: Int
$sel:datapoints:GetScalingPlanResourceForecastDataResponse' :: GetScalingPlanResourceForecastDataResponse -> [Datapoint]
$sel:httpStatus:GetScalingPlanResourceForecastDataResponse' :: GetScalingPlanResourceForecastDataResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Datapoint]
datapoints