{-# 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.Forecast.DescribeWhatIfAnalysis
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the what-if analysis created using the CreateWhatIfAnalysis
-- operation.
--
-- In addition to listing the properties provided in the
-- @CreateWhatIfAnalysis@ request, this operation lists the following
-- properties:
--
-- -   @CreationTime@
--
-- -   @LastModificationTime@
--
-- -   @Message@ - If an error occurred, information about the error.
--
-- -   @Status@
module Amazonka.Forecast.DescribeWhatIfAnalysis
  ( -- * Creating a Request
    DescribeWhatIfAnalysis (..),
    newDescribeWhatIfAnalysis,

    -- * Request Lenses
    describeWhatIfAnalysis_whatIfAnalysisArn,

    -- * Destructuring the Response
    DescribeWhatIfAnalysisResponse (..),
    newDescribeWhatIfAnalysisResponse,

    -- * Response Lenses
    describeWhatIfAnalysisResponse_creationTime,
    describeWhatIfAnalysisResponse_estimatedTimeRemainingInMinutes,
    describeWhatIfAnalysisResponse_forecastArn,
    describeWhatIfAnalysisResponse_lastModificationTime,
    describeWhatIfAnalysisResponse_message,
    describeWhatIfAnalysisResponse_status,
    describeWhatIfAnalysisResponse_timeSeriesSelector,
    describeWhatIfAnalysisResponse_whatIfAnalysisArn,
    describeWhatIfAnalysisResponse_whatIfAnalysisName,
    describeWhatIfAnalysisResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeWhatIfAnalysis' smart constructor.
data DescribeWhatIfAnalysis = DescribeWhatIfAnalysis'
  { -- | The Amazon Resource Name (ARN) of the what-if analysis that you are
    -- interested in.
    DescribeWhatIfAnalysis -> Text
whatIfAnalysisArn :: Prelude.Text
  }
  deriving (DescribeWhatIfAnalysis -> DescribeWhatIfAnalysis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWhatIfAnalysis -> DescribeWhatIfAnalysis -> Bool
$c/= :: DescribeWhatIfAnalysis -> DescribeWhatIfAnalysis -> Bool
== :: DescribeWhatIfAnalysis -> DescribeWhatIfAnalysis -> Bool
$c== :: DescribeWhatIfAnalysis -> DescribeWhatIfAnalysis -> Bool
Prelude.Eq, ReadPrec [DescribeWhatIfAnalysis]
ReadPrec DescribeWhatIfAnalysis
Int -> ReadS DescribeWhatIfAnalysis
ReadS [DescribeWhatIfAnalysis]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWhatIfAnalysis]
$creadListPrec :: ReadPrec [DescribeWhatIfAnalysis]
readPrec :: ReadPrec DescribeWhatIfAnalysis
$creadPrec :: ReadPrec DescribeWhatIfAnalysis
readList :: ReadS [DescribeWhatIfAnalysis]
$creadList :: ReadS [DescribeWhatIfAnalysis]
readsPrec :: Int -> ReadS DescribeWhatIfAnalysis
$creadsPrec :: Int -> ReadS DescribeWhatIfAnalysis
Prelude.Read, Int -> DescribeWhatIfAnalysis -> ShowS
[DescribeWhatIfAnalysis] -> ShowS
DescribeWhatIfAnalysis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWhatIfAnalysis] -> ShowS
$cshowList :: [DescribeWhatIfAnalysis] -> ShowS
show :: DescribeWhatIfAnalysis -> String
$cshow :: DescribeWhatIfAnalysis -> String
showsPrec :: Int -> DescribeWhatIfAnalysis -> ShowS
$cshowsPrec :: Int -> DescribeWhatIfAnalysis -> ShowS
Prelude.Show, forall x. Rep DescribeWhatIfAnalysis x -> DescribeWhatIfAnalysis
forall x. DescribeWhatIfAnalysis -> Rep DescribeWhatIfAnalysis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeWhatIfAnalysis x -> DescribeWhatIfAnalysis
$cfrom :: forall x. DescribeWhatIfAnalysis -> Rep DescribeWhatIfAnalysis x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWhatIfAnalysis' 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:
--
-- 'whatIfAnalysisArn', 'describeWhatIfAnalysis_whatIfAnalysisArn' - The Amazon Resource Name (ARN) of the what-if analysis that you are
-- interested in.
newDescribeWhatIfAnalysis ::
  -- | 'whatIfAnalysisArn'
  Prelude.Text ->
  DescribeWhatIfAnalysis
newDescribeWhatIfAnalysis :: Text -> DescribeWhatIfAnalysis
newDescribeWhatIfAnalysis Text
pWhatIfAnalysisArn_ =
  DescribeWhatIfAnalysis'
    { $sel:whatIfAnalysisArn:DescribeWhatIfAnalysis' :: Text
whatIfAnalysisArn =
        Text
pWhatIfAnalysisArn_
    }

-- | The Amazon Resource Name (ARN) of the what-if analysis that you are
-- interested in.
describeWhatIfAnalysis_whatIfAnalysisArn :: Lens.Lens' DescribeWhatIfAnalysis Prelude.Text
describeWhatIfAnalysis_whatIfAnalysisArn :: Lens' DescribeWhatIfAnalysis Text
describeWhatIfAnalysis_whatIfAnalysisArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysis' {Text
whatIfAnalysisArn :: Text
$sel:whatIfAnalysisArn:DescribeWhatIfAnalysis' :: DescribeWhatIfAnalysis -> Text
whatIfAnalysisArn} -> Text
whatIfAnalysisArn) (\s :: DescribeWhatIfAnalysis
s@DescribeWhatIfAnalysis' {} Text
a -> DescribeWhatIfAnalysis
s {$sel:whatIfAnalysisArn:DescribeWhatIfAnalysis' :: Text
whatIfAnalysisArn = Text
a} :: DescribeWhatIfAnalysis)

instance Core.AWSRequest DescribeWhatIfAnalysis where
  type
    AWSResponse DescribeWhatIfAnalysis =
      DescribeWhatIfAnalysisResponse
  request :: (Service -> Service)
-> DescribeWhatIfAnalysis -> Request DescribeWhatIfAnalysis
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 DescribeWhatIfAnalysis
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeWhatIfAnalysis)))
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 POSIX
-> Maybe Integer
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe TimeSeriesSelector
-> Maybe Text
-> Maybe Text
-> Int
-> DescribeWhatIfAnalysisResponse
DescribeWhatIfAnalysisResponse'
            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
"CreationTime")
            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
"EstimatedTimeRemainingInMinutes")
            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
"ForecastArn")
            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
"LastModificationTime")
            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
"Message")
            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
"Status")
            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
"TimeSeriesSelector")
            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
"WhatIfAnalysisArn")
            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
"WhatIfAnalysisName")
            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 DescribeWhatIfAnalysis where
  hashWithSalt :: Int -> DescribeWhatIfAnalysis -> Int
hashWithSalt Int
_salt DescribeWhatIfAnalysis' {Text
whatIfAnalysisArn :: Text
$sel:whatIfAnalysisArn:DescribeWhatIfAnalysis' :: DescribeWhatIfAnalysis -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
whatIfAnalysisArn

instance Prelude.NFData DescribeWhatIfAnalysis where
  rnf :: DescribeWhatIfAnalysis -> ()
rnf DescribeWhatIfAnalysis' {Text
whatIfAnalysisArn :: Text
$sel:whatIfAnalysisArn:DescribeWhatIfAnalysis' :: DescribeWhatIfAnalysis -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
whatIfAnalysisArn

instance Data.ToHeaders DescribeWhatIfAnalysis where
  toHeaders :: DescribeWhatIfAnalysis -> 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
"AmazonForecast.DescribeWhatIfAnalysis" ::
                          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 DescribeWhatIfAnalysis where
  toJSON :: DescribeWhatIfAnalysis -> Value
toJSON DescribeWhatIfAnalysis' {Text
whatIfAnalysisArn :: Text
$sel:whatIfAnalysisArn:DescribeWhatIfAnalysis' :: DescribeWhatIfAnalysis -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"WhatIfAnalysisArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
whatIfAnalysisArn)
          ]
      )

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

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

-- | /See:/ 'newDescribeWhatIfAnalysisResponse' smart constructor.
data DescribeWhatIfAnalysisResponse = DescribeWhatIfAnalysisResponse'
  { -- | When the what-if analysis was created.
    DescribeWhatIfAnalysisResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The approximate time remaining to complete the what-if analysis, in
    -- minutes.
    DescribeWhatIfAnalysisResponse -> Maybe Integer
estimatedTimeRemainingInMinutes :: Prelude.Maybe Prelude.Integer,
    -- | The Amazon Resource Name (ARN) of the what-if forecast.
    DescribeWhatIfAnalysisResponse -> Maybe Text
forecastArn :: Prelude.Maybe Prelude.Text,
    -- | The last time the resource was modified. The timestamp depends on the
    -- status of the job:
    --
    -- -   @CREATE_PENDING@ - The @CreationTime@.
    --
    -- -   @CREATE_IN_PROGRESS@ - The current timestamp.
    --
    -- -   @CREATE_STOPPING@ - The current timestamp.
    --
    -- -   @CREATE_STOPPED@ - When the job stopped.
    --
    -- -   @ACTIVE@ or @CREATE_FAILED@ - When the job finished or failed.
    DescribeWhatIfAnalysisResponse -> Maybe POSIX
lastModificationTime :: Prelude.Maybe Data.POSIX,
    -- | If an error occurred, an informational message about the error.
    DescribeWhatIfAnalysisResponse -> Maybe Text
message :: Prelude.Maybe Prelude.Text,
    -- | The status of the what-if analysis. States include:
    --
    -- -   @ACTIVE@
    --
    -- -   @CREATE_PENDING@, @CREATE_IN_PROGRESS@, @CREATE_FAILED@
    --
    -- -   @CREATE_STOPPING@, @CREATE_STOPPED@
    --
    -- -   @DELETE_PENDING@, @DELETE_IN_PROGRESS@, @DELETE_FAILED@
    --
    -- The @Status@ of the what-if analysis must be @ACTIVE@ before you can
    -- access the analysis.
    DescribeWhatIfAnalysisResponse -> Maybe Text
status :: Prelude.Maybe Prelude.Text,
    DescribeWhatIfAnalysisResponse -> Maybe TimeSeriesSelector
timeSeriesSelector :: Prelude.Maybe TimeSeriesSelector,
    -- | The Amazon Resource Name (ARN) of the what-if analysis.
    DescribeWhatIfAnalysisResponse -> Maybe Text
whatIfAnalysisArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the what-if analysis.
    DescribeWhatIfAnalysisResponse -> Maybe Text
whatIfAnalysisName :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeWhatIfAnalysisResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeWhatIfAnalysisResponse
-> DescribeWhatIfAnalysisResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeWhatIfAnalysisResponse
-> DescribeWhatIfAnalysisResponse -> Bool
$c/= :: DescribeWhatIfAnalysisResponse
-> DescribeWhatIfAnalysisResponse -> Bool
== :: DescribeWhatIfAnalysisResponse
-> DescribeWhatIfAnalysisResponse -> Bool
$c== :: DescribeWhatIfAnalysisResponse
-> DescribeWhatIfAnalysisResponse -> Bool
Prelude.Eq, ReadPrec [DescribeWhatIfAnalysisResponse]
ReadPrec DescribeWhatIfAnalysisResponse
Int -> ReadS DescribeWhatIfAnalysisResponse
ReadS [DescribeWhatIfAnalysisResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeWhatIfAnalysisResponse]
$creadListPrec :: ReadPrec [DescribeWhatIfAnalysisResponse]
readPrec :: ReadPrec DescribeWhatIfAnalysisResponse
$creadPrec :: ReadPrec DescribeWhatIfAnalysisResponse
readList :: ReadS [DescribeWhatIfAnalysisResponse]
$creadList :: ReadS [DescribeWhatIfAnalysisResponse]
readsPrec :: Int -> ReadS DescribeWhatIfAnalysisResponse
$creadsPrec :: Int -> ReadS DescribeWhatIfAnalysisResponse
Prelude.Read, Int -> DescribeWhatIfAnalysisResponse -> ShowS
[DescribeWhatIfAnalysisResponse] -> ShowS
DescribeWhatIfAnalysisResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeWhatIfAnalysisResponse] -> ShowS
$cshowList :: [DescribeWhatIfAnalysisResponse] -> ShowS
show :: DescribeWhatIfAnalysisResponse -> String
$cshow :: DescribeWhatIfAnalysisResponse -> String
showsPrec :: Int -> DescribeWhatIfAnalysisResponse -> ShowS
$cshowsPrec :: Int -> DescribeWhatIfAnalysisResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeWhatIfAnalysisResponse x
-> DescribeWhatIfAnalysisResponse
forall x.
DescribeWhatIfAnalysisResponse
-> Rep DescribeWhatIfAnalysisResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeWhatIfAnalysisResponse x
-> DescribeWhatIfAnalysisResponse
$cfrom :: forall x.
DescribeWhatIfAnalysisResponse
-> Rep DescribeWhatIfAnalysisResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeWhatIfAnalysisResponse' 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:
--
-- 'creationTime', 'describeWhatIfAnalysisResponse_creationTime' - When the what-if analysis was created.
--
-- 'estimatedTimeRemainingInMinutes', 'describeWhatIfAnalysisResponse_estimatedTimeRemainingInMinutes' - The approximate time remaining to complete the what-if analysis, in
-- minutes.
--
-- 'forecastArn', 'describeWhatIfAnalysisResponse_forecastArn' - The Amazon Resource Name (ARN) of the what-if forecast.
--
-- 'lastModificationTime', 'describeWhatIfAnalysisResponse_lastModificationTime' - The last time the resource was modified. The timestamp depends on the
-- status of the job:
--
-- -   @CREATE_PENDING@ - The @CreationTime@.
--
-- -   @CREATE_IN_PROGRESS@ - The current timestamp.
--
-- -   @CREATE_STOPPING@ - The current timestamp.
--
-- -   @CREATE_STOPPED@ - When the job stopped.
--
-- -   @ACTIVE@ or @CREATE_FAILED@ - When the job finished or failed.
--
-- 'message', 'describeWhatIfAnalysisResponse_message' - If an error occurred, an informational message about the error.
--
-- 'status', 'describeWhatIfAnalysisResponse_status' - The status of the what-if analysis. States include:
--
-- -   @ACTIVE@
--
-- -   @CREATE_PENDING@, @CREATE_IN_PROGRESS@, @CREATE_FAILED@
--
-- -   @CREATE_STOPPING@, @CREATE_STOPPED@
--
-- -   @DELETE_PENDING@, @DELETE_IN_PROGRESS@, @DELETE_FAILED@
--
-- The @Status@ of the what-if analysis must be @ACTIVE@ before you can
-- access the analysis.
--
-- 'timeSeriesSelector', 'describeWhatIfAnalysisResponse_timeSeriesSelector' - Undocumented member.
--
-- 'whatIfAnalysisArn', 'describeWhatIfAnalysisResponse_whatIfAnalysisArn' - The Amazon Resource Name (ARN) of the what-if analysis.
--
-- 'whatIfAnalysisName', 'describeWhatIfAnalysisResponse_whatIfAnalysisName' - The name of the what-if analysis.
--
-- 'httpStatus', 'describeWhatIfAnalysisResponse_httpStatus' - The response's http status code.
newDescribeWhatIfAnalysisResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeWhatIfAnalysisResponse
newDescribeWhatIfAnalysisResponse :: Int -> DescribeWhatIfAnalysisResponse
newDescribeWhatIfAnalysisResponse Int
pHttpStatus_ =
  DescribeWhatIfAnalysisResponse'
    { $sel:creationTime:DescribeWhatIfAnalysisResponse' :: Maybe POSIX
creationTime =
        forall a. Maybe a
Prelude.Nothing,
      $sel:estimatedTimeRemainingInMinutes:DescribeWhatIfAnalysisResponse' :: Maybe Integer
estimatedTimeRemainingInMinutes =
        forall a. Maybe a
Prelude.Nothing,
      $sel:forecastArn:DescribeWhatIfAnalysisResponse' :: Maybe Text
forecastArn = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModificationTime:DescribeWhatIfAnalysisResponse' :: Maybe POSIX
lastModificationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:message:DescribeWhatIfAnalysisResponse' :: Maybe Text
message = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeWhatIfAnalysisResponse' :: Maybe Text
status = forall a. Maybe a
Prelude.Nothing,
      $sel:timeSeriesSelector:DescribeWhatIfAnalysisResponse' :: Maybe TimeSeriesSelector
timeSeriesSelector = forall a. Maybe a
Prelude.Nothing,
      $sel:whatIfAnalysisArn:DescribeWhatIfAnalysisResponse' :: Maybe Text
whatIfAnalysisArn = forall a. Maybe a
Prelude.Nothing,
      $sel:whatIfAnalysisName:DescribeWhatIfAnalysisResponse' :: Maybe Text
whatIfAnalysisName = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeWhatIfAnalysisResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | When the what-if analysis was created.
describeWhatIfAnalysisResponse_creationTime :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe Prelude.UTCTime)
describeWhatIfAnalysisResponse_creationTime :: Lens' DescribeWhatIfAnalysisResponse (Maybe UTCTime)
describeWhatIfAnalysisResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe POSIX
a -> DescribeWhatIfAnalysisResponse
s {$sel:creationTime:DescribeWhatIfAnalysisResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: DescribeWhatIfAnalysisResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The approximate time remaining to complete the what-if analysis, in
-- minutes.
describeWhatIfAnalysisResponse_estimatedTimeRemainingInMinutes :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe Prelude.Integer)
describeWhatIfAnalysisResponse_estimatedTimeRemainingInMinutes :: Lens' DescribeWhatIfAnalysisResponse (Maybe Integer)
describeWhatIfAnalysisResponse_estimatedTimeRemainingInMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe Integer
estimatedTimeRemainingInMinutes :: Maybe Integer
$sel:estimatedTimeRemainingInMinutes:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Integer
estimatedTimeRemainingInMinutes} -> Maybe Integer
estimatedTimeRemainingInMinutes) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe Integer
a -> DescribeWhatIfAnalysisResponse
s {$sel:estimatedTimeRemainingInMinutes:DescribeWhatIfAnalysisResponse' :: Maybe Integer
estimatedTimeRemainingInMinutes = Maybe Integer
a} :: DescribeWhatIfAnalysisResponse)

-- | The Amazon Resource Name (ARN) of the what-if forecast.
describeWhatIfAnalysisResponse_forecastArn :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe Prelude.Text)
describeWhatIfAnalysisResponse_forecastArn :: Lens' DescribeWhatIfAnalysisResponse (Maybe Text)
describeWhatIfAnalysisResponse_forecastArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe Text
forecastArn :: Maybe Text
$sel:forecastArn:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
forecastArn} -> Maybe Text
forecastArn) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe Text
a -> DescribeWhatIfAnalysisResponse
s {$sel:forecastArn:DescribeWhatIfAnalysisResponse' :: Maybe Text
forecastArn = Maybe Text
a} :: DescribeWhatIfAnalysisResponse)

-- | The last time the resource was modified. The timestamp depends on the
-- status of the job:
--
-- -   @CREATE_PENDING@ - The @CreationTime@.
--
-- -   @CREATE_IN_PROGRESS@ - The current timestamp.
--
-- -   @CREATE_STOPPING@ - The current timestamp.
--
-- -   @CREATE_STOPPED@ - When the job stopped.
--
-- -   @ACTIVE@ or @CREATE_FAILED@ - When the job finished or failed.
describeWhatIfAnalysisResponse_lastModificationTime :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe Prelude.UTCTime)
describeWhatIfAnalysisResponse_lastModificationTime :: Lens' DescribeWhatIfAnalysisResponse (Maybe UTCTime)
describeWhatIfAnalysisResponse_lastModificationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe POSIX
lastModificationTime :: Maybe POSIX
$sel:lastModificationTime:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe POSIX
lastModificationTime} -> Maybe POSIX
lastModificationTime) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe POSIX
a -> DescribeWhatIfAnalysisResponse
s {$sel:lastModificationTime:DescribeWhatIfAnalysisResponse' :: Maybe POSIX
lastModificationTime = Maybe POSIX
a} :: DescribeWhatIfAnalysisResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | If an error occurred, an informational message about the error.
describeWhatIfAnalysisResponse_message :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe Prelude.Text)
describeWhatIfAnalysisResponse_message :: Lens' DescribeWhatIfAnalysisResponse (Maybe Text)
describeWhatIfAnalysisResponse_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe Text
message :: Maybe Text
$sel:message:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
message} -> Maybe Text
message) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe Text
a -> DescribeWhatIfAnalysisResponse
s {$sel:message:DescribeWhatIfAnalysisResponse' :: Maybe Text
message = Maybe Text
a} :: DescribeWhatIfAnalysisResponse)

-- | The status of the what-if analysis. States include:
--
-- -   @ACTIVE@
--
-- -   @CREATE_PENDING@, @CREATE_IN_PROGRESS@, @CREATE_FAILED@
--
-- -   @CREATE_STOPPING@, @CREATE_STOPPED@
--
-- -   @DELETE_PENDING@, @DELETE_IN_PROGRESS@, @DELETE_FAILED@
--
-- The @Status@ of the what-if analysis must be @ACTIVE@ before you can
-- access the analysis.
describeWhatIfAnalysisResponse_status :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe Prelude.Text)
describeWhatIfAnalysisResponse_status :: Lens' DescribeWhatIfAnalysisResponse (Maybe Text)
describeWhatIfAnalysisResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe Text
status :: Maybe Text
$sel:status:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
status} -> Maybe Text
status) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe Text
a -> DescribeWhatIfAnalysisResponse
s {$sel:status:DescribeWhatIfAnalysisResponse' :: Maybe Text
status = Maybe Text
a} :: DescribeWhatIfAnalysisResponse)

-- | Undocumented member.
describeWhatIfAnalysisResponse_timeSeriesSelector :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe TimeSeriesSelector)
describeWhatIfAnalysisResponse_timeSeriesSelector :: Lens' DescribeWhatIfAnalysisResponse (Maybe TimeSeriesSelector)
describeWhatIfAnalysisResponse_timeSeriesSelector = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe TimeSeriesSelector
timeSeriesSelector :: Maybe TimeSeriesSelector
$sel:timeSeriesSelector:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe TimeSeriesSelector
timeSeriesSelector} -> Maybe TimeSeriesSelector
timeSeriesSelector) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe TimeSeriesSelector
a -> DescribeWhatIfAnalysisResponse
s {$sel:timeSeriesSelector:DescribeWhatIfAnalysisResponse' :: Maybe TimeSeriesSelector
timeSeriesSelector = Maybe TimeSeriesSelector
a} :: DescribeWhatIfAnalysisResponse)

-- | The Amazon Resource Name (ARN) of the what-if analysis.
describeWhatIfAnalysisResponse_whatIfAnalysisArn :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe Prelude.Text)
describeWhatIfAnalysisResponse_whatIfAnalysisArn :: Lens' DescribeWhatIfAnalysisResponse (Maybe Text)
describeWhatIfAnalysisResponse_whatIfAnalysisArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe Text
whatIfAnalysisArn :: Maybe Text
$sel:whatIfAnalysisArn:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
whatIfAnalysisArn} -> Maybe Text
whatIfAnalysisArn) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe Text
a -> DescribeWhatIfAnalysisResponse
s {$sel:whatIfAnalysisArn:DescribeWhatIfAnalysisResponse' :: Maybe Text
whatIfAnalysisArn = Maybe Text
a} :: DescribeWhatIfAnalysisResponse)

-- | The name of the what-if analysis.
describeWhatIfAnalysisResponse_whatIfAnalysisName :: Lens.Lens' DescribeWhatIfAnalysisResponse (Prelude.Maybe Prelude.Text)
describeWhatIfAnalysisResponse_whatIfAnalysisName :: Lens' DescribeWhatIfAnalysisResponse (Maybe Text)
describeWhatIfAnalysisResponse_whatIfAnalysisName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeWhatIfAnalysisResponse' {Maybe Text
whatIfAnalysisName :: Maybe Text
$sel:whatIfAnalysisName:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
whatIfAnalysisName} -> Maybe Text
whatIfAnalysisName) (\s :: DescribeWhatIfAnalysisResponse
s@DescribeWhatIfAnalysisResponse' {} Maybe Text
a -> DescribeWhatIfAnalysisResponse
s {$sel:whatIfAnalysisName:DescribeWhatIfAnalysisResponse' :: Maybe Text
whatIfAnalysisName = Maybe Text
a} :: DescribeWhatIfAnalysisResponse)

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

instance
  Prelude.NFData
    DescribeWhatIfAnalysisResponse
  where
  rnf :: DescribeWhatIfAnalysisResponse -> ()
rnf DescribeWhatIfAnalysisResponse' {Int
Maybe Integer
Maybe Text
Maybe POSIX
Maybe TimeSeriesSelector
httpStatus :: Int
whatIfAnalysisName :: Maybe Text
whatIfAnalysisArn :: Maybe Text
timeSeriesSelector :: Maybe TimeSeriesSelector
status :: Maybe Text
message :: Maybe Text
lastModificationTime :: Maybe POSIX
forecastArn :: Maybe Text
estimatedTimeRemainingInMinutes :: Maybe Integer
creationTime :: Maybe POSIX
$sel:httpStatus:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Int
$sel:whatIfAnalysisName:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
$sel:whatIfAnalysisArn:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
$sel:timeSeriesSelector:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe TimeSeriesSelector
$sel:status:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
$sel:message:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
$sel:lastModificationTime:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe POSIX
$sel:forecastArn:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Text
$sel:estimatedTimeRemainingInMinutes:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe Integer
$sel:creationTime:DescribeWhatIfAnalysisResponse' :: DescribeWhatIfAnalysisResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Integer
estimatedTimeRemainingInMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
forecastArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModificationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
message
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimeSeriesSelector
timeSeriesSelector
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
whatIfAnalysisArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
whatIfAnalysisName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus