{-# 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.GetAnomalySubscriptions
-- 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 cost anomaly subscription objects for your account. You
-- can filter using a list of cost anomaly monitor Amazon Resource Names
-- (ARNs).
module Amazonka.CostExplorer.GetAnomalySubscriptions
  ( -- * Creating a Request
    GetAnomalySubscriptions (..),
    newGetAnomalySubscriptions,

    -- * Request Lenses
    getAnomalySubscriptions_maxResults,
    getAnomalySubscriptions_monitorArn,
    getAnomalySubscriptions_nextPageToken,
    getAnomalySubscriptions_subscriptionArnList,

    -- * Destructuring the Response
    GetAnomalySubscriptionsResponse (..),
    newGetAnomalySubscriptionsResponse,

    -- * Response Lenses
    getAnomalySubscriptionsResponse_nextPageToken,
    getAnomalySubscriptionsResponse_httpStatus,
    getAnomalySubscriptionsResponse_anomalySubscriptions,
  )
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:/ 'newGetAnomalySubscriptions' smart constructor.
data GetAnomalySubscriptions = GetAnomalySubscriptions'
  { -- | The number of entries a paginated response contains.
    GetAnomalySubscriptions -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | Cost anomaly monitor ARNs.
    GetAnomalySubscriptions -> 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.
    GetAnomalySubscriptions -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | A list of cost anomaly subscription ARNs.
    GetAnomalySubscriptions -> Maybe [Text]
subscriptionArnList :: Prelude.Maybe [Prelude.Text]
  }
  deriving (GetAnomalySubscriptions -> GetAnomalySubscriptions -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAnomalySubscriptions -> GetAnomalySubscriptions -> Bool
$c/= :: GetAnomalySubscriptions -> GetAnomalySubscriptions -> Bool
== :: GetAnomalySubscriptions -> GetAnomalySubscriptions -> Bool
$c== :: GetAnomalySubscriptions -> GetAnomalySubscriptions -> Bool
Prelude.Eq, ReadPrec [GetAnomalySubscriptions]
ReadPrec GetAnomalySubscriptions
Int -> ReadS GetAnomalySubscriptions
ReadS [GetAnomalySubscriptions]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAnomalySubscriptions]
$creadListPrec :: ReadPrec [GetAnomalySubscriptions]
readPrec :: ReadPrec GetAnomalySubscriptions
$creadPrec :: ReadPrec GetAnomalySubscriptions
readList :: ReadS [GetAnomalySubscriptions]
$creadList :: ReadS [GetAnomalySubscriptions]
readsPrec :: Int -> ReadS GetAnomalySubscriptions
$creadsPrec :: Int -> ReadS GetAnomalySubscriptions
Prelude.Read, Int -> GetAnomalySubscriptions -> ShowS
[GetAnomalySubscriptions] -> ShowS
GetAnomalySubscriptions -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAnomalySubscriptions] -> ShowS
$cshowList :: [GetAnomalySubscriptions] -> ShowS
show :: GetAnomalySubscriptions -> String
$cshow :: GetAnomalySubscriptions -> String
showsPrec :: Int -> GetAnomalySubscriptions -> ShowS
$cshowsPrec :: Int -> GetAnomalySubscriptions -> ShowS
Prelude.Show, forall x. Rep GetAnomalySubscriptions x -> GetAnomalySubscriptions
forall x. GetAnomalySubscriptions -> Rep GetAnomalySubscriptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetAnomalySubscriptions x -> GetAnomalySubscriptions
$cfrom :: forall x. GetAnomalySubscriptions -> Rep GetAnomalySubscriptions x
Prelude.Generic)

-- |
-- Create a value of 'GetAnomalySubscriptions' 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:
--
-- 'maxResults', 'getAnomalySubscriptions_maxResults' - The number of entries a paginated response contains.
--
-- 'monitorArn', 'getAnomalySubscriptions_monitorArn' - Cost anomaly monitor ARNs.
--
-- 'nextPageToken', 'getAnomalySubscriptions_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.
--
-- 'subscriptionArnList', 'getAnomalySubscriptions_subscriptionArnList' - A list of cost anomaly subscription ARNs.
newGetAnomalySubscriptions ::
  GetAnomalySubscriptions
newGetAnomalySubscriptions :: GetAnomalySubscriptions
newGetAnomalySubscriptions =
  GetAnomalySubscriptions'
    { $sel:maxResults:GetAnomalySubscriptions' :: Maybe Int
maxResults =
        forall a. Maybe a
Prelude.Nothing,
      $sel:monitorArn:GetAnomalySubscriptions' :: Maybe Text
monitorArn = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:GetAnomalySubscriptions' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:subscriptionArnList:GetAnomalySubscriptions' :: Maybe [Text]
subscriptionArnList = forall a. Maybe a
Prelude.Nothing
    }

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

-- | Cost anomaly monitor ARNs.
getAnomalySubscriptions_monitorArn :: Lens.Lens' GetAnomalySubscriptions (Prelude.Maybe Prelude.Text)
getAnomalySubscriptions_monitorArn :: Lens' GetAnomalySubscriptions (Maybe Text)
getAnomalySubscriptions_monitorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalySubscriptions' {Maybe Text
monitorArn :: Maybe Text
$sel:monitorArn:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Text
monitorArn} -> Maybe Text
monitorArn) (\s :: GetAnomalySubscriptions
s@GetAnomalySubscriptions' {} Maybe Text
a -> GetAnomalySubscriptions
s {$sel:monitorArn:GetAnomalySubscriptions' :: Maybe Text
monitorArn = Maybe Text
a} :: GetAnomalySubscriptions)

-- | 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.
getAnomalySubscriptions_nextPageToken :: Lens.Lens' GetAnomalySubscriptions (Prelude.Maybe Prelude.Text)
getAnomalySubscriptions_nextPageToken :: Lens' GetAnomalySubscriptions (Maybe Text)
getAnomalySubscriptions_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalySubscriptions' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetAnomalySubscriptions
s@GetAnomalySubscriptions' {} Maybe Text
a -> GetAnomalySubscriptions
s {$sel:nextPageToken:GetAnomalySubscriptions' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetAnomalySubscriptions)

-- | A list of cost anomaly subscription ARNs.
getAnomalySubscriptions_subscriptionArnList :: Lens.Lens' GetAnomalySubscriptions (Prelude.Maybe [Prelude.Text])
getAnomalySubscriptions_subscriptionArnList :: Lens' GetAnomalySubscriptions (Maybe [Text])
getAnomalySubscriptions_subscriptionArnList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalySubscriptions' {Maybe [Text]
subscriptionArnList :: Maybe [Text]
$sel:subscriptionArnList:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe [Text]
subscriptionArnList} -> Maybe [Text]
subscriptionArnList) (\s :: GetAnomalySubscriptions
s@GetAnomalySubscriptions' {} Maybe [Text]
a -> GetAnomalySubscriptions
s {$sel:subscriptionArnList:GetAnomalySubscriptions' :: Maybe [Text]
subscriptionArnList = Maybe [Text]
a} :: GetAnomalySubscriptions) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.Hashable GetAnomalySubscriptions where
  hashWithSalt :: Int -> GetAnomalySubscriptions -> Int
hashWithSalt Int
_salt GetAnomalySubscriptions' {Maybe Int
Maybe [Text]
Maybe Text
subscriptionArnList :: Maybe [Text]
nextPageToken :: Maybe Text
monitorArn :: Maybe Text
maxResults :: Maybe Int
$sel:subscriptionArnList:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe [Text]
$sel:nextPageToken:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Text
$sel:monitorArn:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Text
$sel:maxResults:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Int
..} =
    Int
_salt
      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 [Text]
subscriptionArnList

instance Prelude.NFData GetAnomalySubscriptions where
  rnf :: GetAnomalySubscriptions -> ()
rnf GetAnomalySubscriptions' {Maybe Int
Maybe [Text]
Maybe Text
subscriptionArnList :: Maybe [Text]
nextPageToken :: Maybe Text
monitorArn :: Maybe Text
maxResults :: Maybe Int
$sel:subscriptionArnList:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe [Text]
$sel:nextPageToken:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Text
$sel:monitorArn:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Text
$sel:maxResults:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Int
..} =
    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 [Text]
subscriptionArnList

instance Data.ToHeaders GetAnomalySubscriptions where
  toHeaders :: GetAnomalySubscriptions -> 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.GetAnomalySubscriptions" ::
                          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 GetAnomalySubscriptions where
  toJSON :: GetAnomalySubscriptions -> Value
toJSON GetAnomalySubscriptions' {Maybe Int
Maybe [Text]
Maybe Text
subscriptionArnList :: Maybe [Text]
nextPageToken :: Maybe Text
monitorArn :: Maybe Text
maxResults :: Maybe Int
$sel:subscriptionArnList:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe [Text]
$sel:nextPageToken:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Text
$sel:monitorArn:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Text
$sel:maxResults:GetAnomalySubscriptions' :: GetAnomalySubscriptions -> Maybe Int
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"SubscriptionArnList" 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]
subscriptionArnList
          ]
      )

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

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

-- | /See:/ 'newGetAnomalySubscriptionsResponse' smart constructor.
data GetAnomalySubscriptionsResponse = GetAnomalySubscriptionsResponse'
  { -- | 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.
    GetAnomalySubscriptionsResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetAnomalySubscriptionsResponse -> Int
httpStatus :: Prelude.Int,
    -- | A list of cost anomaly subscriptions that includes the detailed metadata
    -- for each one.
    GetAnomalySubscriptionsResponse -> [AnomalySubscription]
anomalySubscriptions :: [AnomalySubscription]
  }
  deriving (GetAnomalySubscriptionsResponse
-> GetAnomalySubscriptionsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAnomalySubscriptionsResponse
-> GetAnomalySubscriptionsResponse -> Bool
$c/= :: GetAnomalySubscriptionsResponse
-> GetAnomalySubscriptionsResponse -> Bool
== :: GetAnomalySubscriptionsResponse
-> GetAnomalySubscriptionsResponse -> Bool
$c== :: GetAnomalySubscriptionsResponse
-> GetAnomalySubscriptionsResponse -> Bool
Prelude.Eq, ReadPrec [GetAnomalySubscriptionsResponse]
ReadPrec GetAnomalySubscriptionsResponse
Int -> ReadS GetAnomalySubscriptionsResponse
ReadS [GetAnomalySubscriptionsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAnomalySubscriptionsResponse]
$creadListPrec :: ReadPrec [GetAnomalySubscriptionsResponse]
readPrec :: ReadPrec GetAnomalySubscriptionsResponse
$creadPrec :: ReadPrec GetAnomalySubscriptionsResponse
readList :: ReadS [GetAnomalySubscriptionsResponse]
$creadList :: ReadS [GetAnomalySubscriptionsResponse]
readsPrec :: Int -> ReadS GetAnomalySubscriptionsResponse
$creadsPrec :: Int -> ReadS GetAnomalySubscriptionsResponse
Prelude.Read, Int -> GetAnomalySubscriptionsResponse -> ShowS
[GetAnomalySubscriptionsResponse] -> ShowS
GetAnomalySubscriptionsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAnomalySubscriptionsResponse] -> ShowS
$cshowList :: [GetAnomalySubscriptionsResponse] -> ShowS
show :: GetAnomalySubscriptionsResponse -> String
$cshow :: GetAnomalySubscriptionsResponse -> String
showsPrec :: Int -> GetAnomalySubscriptionsResponse -> ShowS
$cshowsPrec :: Int -> GetAnomalySubscriptionsResponse -> ShowS
Prelude.Show, forall x.
Rep GetAnomalySubscriptionsResponse x
-> GetAnomalySubscriptionsResponse
forall x.
GetAnomalySubscriptionsResponse
-> Rep GetAnomalySubscriptionsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAnomalySubscriptionsResponse x
-> GetAnomalySubscriptionsResponse
$cfrom :: forall x.
GetAnomalySubscriptionsResponse
-> Rep GetAnomalySubscriptionsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAnomalySubscriptionsResponse' 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', 'getAnomalySubscriptionsResponse_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', 'getAnomalySubscriptionsResponse_httpStatus' - The response's http status code.
--
-- 'anomalySubscriptions', 'getAnomalySubscriptionsResponse_anomalySubscriptions' - A list of cost anomaly subscriptions that includes the detailed metadata
-- for each one.
newGetAnomalySubscriptionsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAnomalySubscriptionsResponse
newGetAnomalySubscriptionsResponse :: Int -> GetAnomalySubscriptionsResponse
newGetAnomalySubscriptionsResponse Int
pHttpStatus_ =
  GetAnomalySubscriptionsResponse'
    { $sel:nextPageToken:GetAnomalySubscriptionsResponse' :: Maybe Text
nextPageToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAnomalySubscriptionsResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:anomalySubscriptions:GetAnomalySubscriptionsResponse' :: [AnomalySubscription]
anomalySubscriptions = 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.
getAnomalySubscriptionsResponse_nextPageToken :: Lens.Lens' GetAnomalySubscriptionsResponse (Prelude.Maybe Prelude.Text)
getAnomalySubscriptionsResponse_nextPageToken :: Lens' GetAnomalySubscriptionsResponse (Maybe Text)
getAnomalySubscriptionsResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalySubscriptionsResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetAnomalySubscriptionsResponse' :: GetAnomalySubscriptionsResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetAnomalySubscriptionsResponse
s@GetAnomalySubscriptionsResponse' {} Maybe Text
a -> GetAnomalySubscriptionsResponse
s {$sel:nextPageToken:GetAnomalySubscriptionsResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetAnomalySubscriptionsResponse)

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

-- | A list of cost anomaly subscriptions that includes the detailed metadata
-- for each one.
getAnomalySubscriptionsResponse_anomalySubscriptions :: Lens.Lens' GetAnomalySubscriptionsResponse [AnomalySubscription]
getAnomalySubscriptionsResponse_anomalySubscriptions :: Lens' GetAnomalySubscriptionsResponse [AnomalySubscription]
getAnomalySubscriptionsResponse_anomalySubscriptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAnomalySubscriptionsResponse' {[AnomalySubscription]
anomalySubscriptions :: [AnomalySubscription]
$sel:anomalySubscriptions:GetAnomalySubscriptionsResponse' :: GetAnomalySubscriptionsResponse -> [AnomalySubscription]
anomalySubscriptions} -> [AnomalySubscription]
anomalySubscriptions) (\s :: GetAnomalySubscriptionsResponse
s@GetAnomalySubscriptionsResponse' {} [AnomalySubscription]
a -> GetAnomalySubscriptionsResponse
s {$sel:anomalySubscriptions:GetAnomalySubscriptionsResponse' :: [AnomalySubscription]
anomalySubscriptions = [AnomalySubscription]
a} :: GetAnomalySubscriptionsResponse) 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
    GetAnomalySubscriptionsResponse
  where
  rnf :: GetAnomalySubscriptionsResponse -> ()
rnf GetAnomalySubscriptionsResponse' {Int
[AnomalySubscription]
Maybe Text
anomalySubscriptions :: [AnomalySubscription]
httpStatus :: Int
nextPageToken :: Maybe Text
$sel:anomalySubscriptions:GetAnomalySubscriptionsResponse' :: GetAnomalySubscriptionsResponse -> [AnomalySubscription]
$sel:httpStatus:GetAnomalySubscriptionsResponse' :: GetAnomalySubscriptionsResponse -> Int
$sel:nextPageToken:GetAnomalySubscriptionsResponse' :: GetAnomalySubscriptionsResponse -> 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 [AnomalySubscription]
anomalySubscriptions