{-# 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.GetAnomalies
-- 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 all of the cost anomalies detected on your account during the
-- time period that\'s specified by the @DateInterval@ object. Anomalies
-- are available for up to 90 days.
module Amazonka.CostExplorer.GetAnomalies
  ( -- * Creating a Request
    GetAnomalies (..),
    newGetAnomalies,

    -- * Request Lenses
    getAnomalies_feedback,
    getAnomalies_maxResults,
    getAnomalies_monitorArn,
    getAnomalies_nextPageToken,
    getAnomalies_totalImpact,
    getAnomalies_dateInterval,

    -- * Destructuring the Response
    GetAnomaliesResponse (..),
    newGetAnomaliesResponse,

    -- * Response Lenses
    getAnomaliesResponse_nextPageToken,
    getAnomaliesResponse_httpStatus,
    getAnomaliesResponse_anomalies,
  )
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:/ 'newGetAnomalies' smart constructor.
data GetAnomalies = GetAnomalies'
  { -- | Filters anomaly results by the feedback field on the anomaly object.
    GetAnomalies -> Maybe AnomalyFeedbackType
feedback :: Prelude.Maybe AnomalyFeedbackType,
    -- | The number of entries a paginated response contains.
    GetAnomalies -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | Retrieves all of the cost anomalies detected for a specific cost anomaly
    -- monitor Amazon Resource Name (ARN).
    GetAnomalies -> Maybe Text
monitorArn :: Prelude.Maybe Prelude.Text,
    -- | The token to retrieve the next set of results. Amazon Web Services
    -- provides the token when the response from a previous call has more
    -- results than the maximum page size.
    GetAnomalies -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | Filters anomaly results by the total impact field on the anomaly object.
    -- For example, you can filter anomalies @GREATER_THAN 200.00@ to retrieve
    -- anomalies, with an estimated dollar impact greater than 200.
    GetAnomalies -> Maybe TotalImpactFilter
totalImpact :: Prelude.Maybe TotalImpactFilter,
    -- | Assigns the start and end dates for retrieving cost anomalies. The
    -- returned anomaly object will have an @AnomalyEndDate@ in the specified
    -- time range.
    GetAnomalies -> AnomalyDateInterval
dateInterval :: AnomalyDateInterval
  }
  deriving (GetAnomalies -> GetAnomalies -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAnomalies -> GetAnomalies -> Bool
$c/= :: GetAnomalies -> GetAnomalies -> Bool
== :: GetAnomalies -> GetAnomalies -> Bool
$c== :: GetAnomalies -> GetAnomalies -> Bool
Prelude.Eq, ReadPrec [GetAnomalies]
ReadPrec GetAnomalies
Int -> ReadS GetAnomalies
ReadS [GetAnomalies]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAnomalies]
$creadListPrec :: ReadPrec [GetAnomalies]
readPrec :: ReadPrec GetAnomalies
$creadPrec :: ReadPrec GetAnomalies
readList :: ReadS [GetAnomalies]
$creadList :: ReadS [GetAnomalies]
readsPrec :: Int -> ReadS GetAnomalies
$creadsPrec :: Int -> ReadS GetAnomalies
Prelude.Read, Int -> GetAnomalies -> ShowS
[GetAnomalies] -> ShowS
GetAnomalies -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAnomalies] -> ShowS
$cshowList :: [GetAnomalies] -> ShowS
show :: GetAnomalies -> String
$cshow :: GetAnomalies -> String
showsPrec :: Int -> GetAnomalies -> ShowS
$cshowsPrec :: Int -> GetAnomalies -> ShowS
Prelude.Show, forall x. Rep GetAnomalies x -> GetAnomalies
forall x. GetAnomalies -> Rep GetAnomalies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAnomalies x -> GetAnomalies
$cfrom :: forall x. GetAnomalies -> Rep GetAnomalies x
Prelude.Generic)

-- |
-- Create a value of 'GetAnomalies' 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:
--
-- 'feedback', 'getAnomalies_feedback' - Filters anomaly results by the feedback field on the anomaly object.
--
-- 'maxResults', 'getAnomalies_maxResults' - The number of entries a paginated response contains.
--
-- 'monitorArn', 'getAnomalies_monitorArn' - Retrieves all of the cost anomalies detected for a specific cost anomaly
-- monitor Amazon Resource Name (ARN).
--
-- 'nextPageToken', 'getAnomalies_nextPageToken' - The token to retrieve the next set of results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
--
-- 'totalImpact', 'getAnomalies_totalImpact' - Filters anomaly results by the total impact field on the anomaly object.
-- For example, you can filter anomalies @GREATER_THAN 200.00@ to retrieve
-- anomalies, with an estimated dollar impact greater than 200.
--
-- 'dateInterval', 'getAnomalies_dateInterval' - Assigns the start and end dates for retrieving cost anomalies. The
-- returned anomaly object will have an @AnomalyEndDate@ in the specified
-- time range.
newGetAnomalies ::
  -- | 'dateInterval'
  AnomalyDateInterval ->
  GetAnomalies
newGetAnomalies :: AnomalyDateInterval -> GetAnomalies
newGetAnomalies AnomalyDateInterval
pDateInterval_ =
  GetAnomalies'
    { $sel:feedback:GetAnomalies' :: Maybe AnomalyFeedbackType
feedback = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetAnomalies' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:monitorArn:GetAnomalies' :: Maybe Text
monitorArn = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:GetAnomalies' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:totalImpact:GetAnomalies' :: Maybe TotalImpactFilter
totalImpact = forall a. Maybe a
Prelude.Nothing,
      $sel:dateInterval:GetAnomalies' :: AnomalyDateInterval
dateInterval = AnomalyDateInterval
pDateInterval_
    }

-- | Filters anomaly results by the feedback field on the anomaly object.
getAnomalies_feedback :: Lens.Lens' GetAnomalies (Prelude.Maybe AnomalyFeedbackType)
getAnomalies_feedback :: Lens' GetAnomalies (Maybe AnomalyFeedbackType)
getAnomalies_feedback = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalies' {Maybe AnomalyFeedbackType
feedback :: Maybe AnomalyFeedbackType
$sel:feedback:GetAnomalies' :: GetAnomalies -> Maybe AnomalyFeedbackType
feedback} -> Maybe AnomalyFeedbackType
feedback) (\s :: GetAnomalies
s@GetAnomalies' {} Maybe AnomalyFeedbackType
a -> GetAnomalies
s {$sel:feedback:GetAnomalies' :: Maybe AnomalyFeedbackType
feedback = Maybe AnomalyFeedbackType
a} :: GetAnomalies)

-- | The number of entries a paginated response contains.
getAnomalies_maxResults :: Lens.Lens' GetAnomalies (Prelude.Maybe Prelude.Int)
getAnomalies_maxResults :: Lens' GetAnomalies (Maybe Int)
getAnomalies_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalies' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:GetAnomalies' :: GetAnomalies -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: GetAnomalies
s@GetAnomalies' {} Maybe Int
a -> GetAnomalies
s {$sel:maxResults:GetAnomalies' :: Maybe Int
maxResults = Maybe Int
a} :: GetAnomalies)

-- | Retrieves all of the cost anomalies detected for a specific cost anomaly
-- monitor Amazon Resource Name (ARN).
getAnomalies_monitorArn :: Lens.Lens' GetAnomalies (Prelude.Maybe Prelude.Text)
getAnomalies_monitorArn :: Lens' GetAnomalies (Maybe Text)
getAnomalies_monitorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalies' {Maybe Text
monitorArn :: Maybe Text
$sel:monitorArn:GetAnomalies' :: GetAnomalies -> Maybe Text
monitorArn} -> Maybe Text
monitorArn) (\s :: GetAnomalies
s@GetAnomalies' {} Maybe Text
a -> GetAnomalies
s {$sel:monitorArn:GetAnomalies' :: Maybe Text
monitorArn = Maybe Text
a} :: GetAnomalies)

-- | The token to retrieve the next set of results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
getAnomalies_nextPageToken :: Lens.Lens' GetAnomalies (Prelude.Maybe Prelude.Text)
getAnomalies_nextPageToken :: Lens' GetAnomalies (Maybe Text)
getAnomalies_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalies' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetAnomalies' :: GetAnomalies -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetAnomalies
s@GetAnomalies' {} Maybe Text
a -> GetAnomalies
s {$sel:nextPageToken:GetAnomalies' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetAnomalies)

-- | Filters anomaly results by the total impact field on the anomaly object.
-- For example, you can filter anomalies @GREATER_THAN 200.00@ to retrieve
-- anomalies, with an estimated dollar impact greater than 200.
getAnomalies_totalImpact :: Lens.Lens' GetAnomalies (Prelude.Maybe TotalImpactFilter)
getAnomalies_totalImpact :: Lens' GetAnomalies (Maybe TotalImpactFilter)
getAnomalies_totalImpact = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalies' {Maybe TotalImpactFilter
totalImpact :: Maybe TotalImpactFilter
$sel:totalImpact:GetAnomalies' :: GetAnomalies -> Maybe TotalImpactFilter
totalImpact} -> Maybe TotalImpactFilter
totalImpact) (\s :: GetAnomalies
s@GetAnomalies' {} Maybe TotalImpactFilter
a -> GetAnomalies
s {$sel:totalImpact:GetAnomalies' :: Maybe TotalImpactFilter
totalImpact = Maybe TotalImpactFilter
a} :: GetAnomalies)

-- | Assigns the start and end dates for retrieving cost anomalies. The
-- returned anomaly object will have an @AnomalyEndDate@ in the specified
-- time range.
getAnomalies_dateInterval :: Lens.Lens' GetAnomalies AnomalyDateInterval
getAnomalies_dateInterval :: Lens' GetAnomalies AnomalyDateInterval
getAnomalies_dateInterval = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalies' {AnomalyDateInterval
dateInterval :: AnomalyDateInterval
$sel:dateInterval:GetAnomalies' :: GetAnomalies -> AnomalyDateInterval
dateInterval} -> AnomalyDateInterval
dateInterval) (\s :: GetAnomalies
s@GetAnomalies' {} AnomalyDateInterval
a -> GetAnomalies
s {$sel:dateInterval:GetAnomalies' :: AnomalyDateInterval
dateInterval = AnomalyDateInterval
a} :: GetAnomalies)

instance Core.AWSRequest GetAnomalies where
  type AWSResponse GetAnomalies = GetAnomaliesResponse
  request :: (Service -> Service) -> GetAnomalies -> Request GetAnomalies
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 GetAnomalies
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetAnomalies)))
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 Text -> Int -> [Anomaly] -> GetAnomaliesResponse
GetAnomaliesResponse'
            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
"NextPageToken")
            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))
            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
"Anomalies" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable GetAnomalies where
  hashWithSalt :: Int -> GetAnomalies -> Int
hashWithSalt Int
_salt GetAnomalies' {Maybe Int
Maybe Text
Maybe AnomalyFeedbackType
Maybe TotalImpactFilter
AnomalyDateInterval
dateInterval :: AnomalyDateInterval
totalImpact :: Maybe TotalImpactFilter
nextPageToken :: Maybe Text
monitorArn :: Maybe Text
maxResults :: Maybe Int
feedback :: Maybe AnomalyFeedbackType
$sel:dateInterval:GetAnomalies' :: GetAnomalies -> AnomalyDateInterval
$sel:totalImpact:GetAnomalies' :: GetAnomalies -> Maybe TotalImpactFilter
$sel:nextPageToken:GetAnomalies' :: GetAnomalies -> Maybe Text
$sel:monitorArn:GetAnomalies' :: GetAnomalies -> Maybe Text
$sel:maxResults:GetAnomalies' :: GetAnomalies -> Maybe Int
$sel:feedback:GetAnomalies' :: GetAnomalies -> Maybe AnomalyFeedbackType
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AnomalyFeedbackType
feedback
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
monitorArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextPageToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TotalImpactFilter
totalImpact
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AnomalyDateInterval
dateInterval

instance Prelude.NFData GetAnomalies where
  rnf :: GetAnomalies -> ()
rnf GetAnomalies' {Maybe Int
Maybe Text
Maybe AnomalyFeedbackType
Maybe TotalImpactFilter
AnomalyDateInterval
dateInterval :: AnomalyDateInterval
totalImpact :: Maybe TotalImpactFilter
nextPageToken :: Maybe Text
monitorArn :: Maybe Text
maxResults :: Maybe Int
feedback :: Maybe AnomalyFeedbackType
$sel:dateInterval:GetAnomalies' :: GetAnomalies -> AnomalyDateInterval
$sel:totalImpact:GetAnomalies' :: GetAnomalies -> Maybe TotalImpactFilter
$sel:nextPageToken:GetAnomalies' :: GetAnomalies -> Maybe Text
$sel:monitorArn:GetAnomalies' :: GetAnomalies -> Maybe Text
$sel:maxResults:GetAnomalies' :: GetAnomalies -> Maybe Int
$sel:feedback:GetAnomalies' :: GetAnomalies -> Maybe AnomalyFeedbackType
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AnomalyFeedbackType
feedback
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
monitorArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TotalImpactFilter
totalImpact
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AnomalyDateInterval
dateInterval

instance Data.ToHeaders GetAnomalies where
  toHeaders :: GetAnomalies -> 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.GetAnomalies" ::
                          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 GetAnomalies where
  toJSON :: GetAnomalies -> Value
toJSON GetAnomalies' {Maybe Int
Maybe Text
Maybe AnomalyFeedbackType
Maybe TotalImpactFilter
AnomalyDateInterval
dateInterval :: AnomalyDateInterval
totalImpact :: Maybe TotalImpactFilter
nextPageToken :: Maybe Text
monitorArn :: Maybe Text
maxResults :: Maybe Int
feedback :: Maybe AnomalyFeedbackType
$sel:dateInterval:GetAnomalies' :: GetAnomalies -> AnomalyDateInterval
$sel:totalImpact:GetAnomalies' :: GetAnomalies -> Maybe TotalImpactFilter
$sel:nextPageToken:GetAnomalies' :: GetAnomalies -> Maybe Text
$sel:monitorArn:GetAnomalies' :: GetAnomalies -> Maybe Text
$sel:maxResults:GetAnomalies' :: GetAnomalies -> Maybe Int
$sel:feedback:GetAnomalies' :: GetAnomalies -> Maybe AnomalyFeedbackType
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Feedback" 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 AnomalyFeedbackType
feedback,
            (Key
"MaxResults" 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 Int
maxResults,
            (Key
"MonitorArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
monitorArn,
            (Key
"NextPageToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextPageToken,
            (Key
"TotalImpact" 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 TotalImpactFilter
totalImpact,
            forall a. a -> Maybe a
Prelude.Just (Key
"DateInterval" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= AnomalyDateInterval
dateInterval)
          ]
      )

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

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

-- | /See:/ 'newGetAnomaliesResponse' smart constructor.
data GetAnomaliesResponse = GetAnomaliesResponse'
  { -- | The token to retrieve the next set of results. Amazon Web Services
    -- provides the token when the response from a previous call has more
    -- results than the maximum page size.
    GetAnomaliesResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetAnomaliesResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of cost anomalies.
    GetAnomaliesResponse -> [Anomaly]
anomalies :: [Anomaly]
  }
  deriving (GetAnomaliesResponse -> GetAnomaliesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAnomaliesResponse -> GetAnomaliesResponse -> Bool
$c/= :: GetAnomaliesResponse -> GetAnomaliesResponse -> Bool
== :: GetAnomaliesResponse -> GetAnomaliesResponse -> Bool
$c== :: GetAnomaliesResponse -> GetAnomaliesResponse -> Bool
Prelude.Eq, ReadPrec [GetAnomaliesResponse]
ReadPrec GetAnomaliesResponse
Int -> ReadS GetAnomaliesResponse
ReadS [GetAnomaliesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAnomaliesResponse]
$creadListPrec :: ReadPrec [GetAnomaliesResponse]
readPrec :: ReadPrec GetAnomaliesResponse
$creadPrec :: ReadPrec GetAnomaliesResponse
readList :: ReadS [GetAnomaliesResponse]
$creadList :: ReadS [GetAnomaliesResponse]
readsPrec :: Int -> ReadS GetAnomaliesResponse
$creadsPrec :: Int -> ReadS GetAnomaliesResponse
Prelude.Read, Int -> GetAnomaliesResponse -> ShowS
[GetAnomaliesResponse] -> ShowS
GetAnomaliesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAnomaliesResponse] -> ShowS
$cshowList :: [GetAnomaliesResponse] -> ShowS
show :: GetAnomaliesResponse -> String
$cshow :: GetAnomaliesResponse -> String
showsPrec :: Int -> GetAnomaliesResponse -> ShowS
$cshowsPrec :: Int -> GetAnomaliesResponse -> ShowS
Prelude.Show, forall x. Rep GetAnomaliesResponse x -> GetAnomaliesResponse
forall x. GetAnomaliesResponse -> Rep GetAnomaliesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAnomaliesResponse x -> GetAnomaliesResponse
$cfrom :: forall x. GetAnomaliesResponse -> Rep GetAnomaliesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAnomaliesResponse' 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:
--
-- 'nextPageToken', 'getAnomaliesResponse_nextPageToken' - The token to retrieve the next set of results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
--
-- 'httpStatus', 'getAnomaliesResponse_httpStatus' - The response's http status code.
--
-- 'anomalies', 'getAnomaliesResponse_anomalies' - A list of cost anomalies.
newGetAnomaliesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAnomaliesResponse
newGetAnomaliesResponse :: Int -> GetAnomaliesResponse
newGetAnomaliesResponse Int
pHttpStatus_ =
  GetAnomaliesResponse'
    { $sel:nextPageToken:GetAnomaliesResponse' :: Maybe Text
nextPageToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAnomaliesResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:anomalies:GetAnomaliesResponse' :: [Anomaly]
anomalies = forall a. Monoid a => a
Prelude.mempty
    }

-- | The token to retrieve the next set of results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
getAnomaliesResponse_nextPageToken :: Lens.Lens' GetAnomaliesResponse (Prelude.Maybe Prelude.Text)
getAnomaliesResponse_nextPageToken :: Lens' GetAnomaliesResponse (Maybe Text)
getAnomaliesResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomaliesResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetAnomaliesResponse' :: GetAnomaliesResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetAnomaliesResponse
s@GetAnomaliesResponse' {} Maybe Text
a -> GetAnomaliesResponse
s {$sel:nextPageToken:GetAnomaliesResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetAnomaliesResponse)

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

-- | A list of cost anomalies.
getAnomaliesResponse_anomalies :: Lens.Lens' GetAnomaliesResponse [Anomaly]
getAnomaliesResponse_anomalies :: Lens' GetAnomaliesResponse [Anomaly]
getAnomaliesResponse_anomalies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomaliesResponse' {[Anomaly]
anomalies :: [Anomaly]
$sel:anomalies:GetAnomaliesResponse' :: GetAnomaliesResponse -> [Anomaly]
anomalies} -> [Anomaly]
anomalies) (\s :: GetAnomaliesResponse
s@GetAnomaliesResponse' {} [Anomaly]
a -> GetAnomaliesResponse
s {$sel:anomalies:GetAnomaliesResponse' :: [Anomaly]
anomalies = [Anomaly]
a} :: GetAnomaliesResponse) 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 GetAnomaliesResponse where
  rnf :: GetAnomaliesResponse -> ()
rnf GetAnomaliesResponse' {Int
[Anomaly]
Maybe Text
anomalies :: [Anomaly]
httpStatus :: Int
nextPageToken :: Maybe Text
$sel:anomalies:GetAnomaliesResponse' :: GetAnomaliesResponse -> [Anomaly]
$sel:httpStatus:GetAnomaliesResponse' :: GetAnomaliesResponse -> Int
$sel:nextPageToken:GetAnomaliesResponse' :: GetAnomaliesResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextPageToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Anomaly]
anomalies