{-# 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.GetCostCategories
-- 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 an array of Cost Category names and values incurred cost.
--
-- If some Cost Category names and values are not associated with any cost,
-- they will not be returned by this API.
module Amazonka.CostExplorer.GetCostCategories
  ( -- * Creating a Request
    GetCostCategories (..),
    newGetCostCategories,

    -- * Request Lenses
    getCostCategories_costCategoryName,
    getCostCategories_filter,
    getCostCategories_maxResults,
    getCostCategories_nextPageToken,
    getCostCategories_searchString,
    getCostCategories_sortBy,
    getCostCategories_timePeriod,

    -- * Destructuring the Response
    GetCostCategoriesResponse (..),
    newGetCostCategoriesResponse,

    -- * Response Lenses
    getCostCategoriesResponse_costCategoryNames,
    getCostCategoriesResponse_costCategoryValues,
    getCostCategoriesResponse_nextPageToken,
    getCostCategoriesResponse_httpStatus,
    getCostCategoriesResponse_returnSize,
    getCostCategoriesResponse_totalSize,
  )
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:/ 'newGetCostCategories' smart constructor.
data GetCostCategories = GetCostCategories'
  { GetCostCategories -> Maybe Text
costCategoryName :: Prelude.Maybe Prelude.Text,
    GetCostCategories -> Maybe Expression
filter' :: Prelude.Maybe Expression,
    -- | This field is only used when the @SortBy@ value is provided in the
    -- request.
    --
    -- The maximum number of objects that are returned for this request. If
    -- @MaxResults@ isn\'t specified with the @SortBy@ value, the request
    -- returns 1000 results as the default value for this parameter.
    --
    -- For @GetCostCategories@, MaxResults has an upper quota of 1000.
    GetCostCategories -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the number of objects that are still available for retrieval exceeds
    -- the quota, Amazon Web Services returns a NextPageToken value in the
    -- response. To retrieve the next batch of objects, provide the
    -- NextPageToken from the previous call in your next request.
    GetCostCategories -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The value that you want to search the filter values for.
    --
    -- If you don\'t specify a @CostCategoryName@, @SearchString@ is used to
    -- filter Cost Category names that match the @SearchString@ pattern. If you
    -- specify a @CostCategoryName@, @SearchString@ is used to filter Cost
    -- Category values that match the @SearchString@ pattern.
    GetCostCategories -> Maybe Text
searchString :: Prelude.Maybe Prelude.Text,
    -- | The value that you sort the data by.
    --
    -- The key represents the cost and usage metrics. The following values are
    -- supported:
    --
    -- -   @BlendedCost@
    --
    -- -   @UnblendedCost@
    --
    -- -   @AmortizedCost@
    --
    -- -   @NetAmortizedCost@
    --
    -- -   @NetUnblendedCost@
    --
    -- -   @UsageQuantity@
    --
    -- -   @NormalizedUsageAmount@
    --
    -- The supported key values for the @SortOrder@ value are @ASCENDING@ and
    -- @DESCENDING@.
    --
    -- When you use the @SortBy@ value, the @NextPageToken@ and @SearchString@
    -- key values aren\'t supported.
    GetCostCategories -> Maybe [SortDefinition]
sortBy :: Prelude.Maybe [SortDefinition],
    GetCostCategories -> DateInterval
timePeriod :: DateInterval
  }
  deriving (GetCostCategories -> GetCostCategories -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCostCategories -> GetCostCategories -> Bool
$c/= :: GetCostCategories -> GetCostCategories -> Bool
== :: GetCostCategories -> GetCostCategories -> Bool
$c== :: GetCostCategories -> GetCostCategories -> Bool
Prelude.Eq, ReadPrec [GetCostCategories]
ReadPrec GetCostCategories
Int -> ReadS GetCostCategories
ReadS [GetCostCategories]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCostCategories]
$creadListPrec :: ReadPrec [GetCostCategories]
readPrec :: ReadPrec GetCostCategories
$creadPrec :: ReadPrec GetCostCategories
readList :: ReadS [GetCostCategories]
$creadList :: ReadS [GetCostCategories]
readsPrec :: Int -> ReadS GetCostCategories
$creadsPrec :: Int -> ReadS GetCostCategories
Prelude.Read, Int -> GetCostCategories -> ShowS
[GetCostCategories] -> ShowS
GetCostCategories -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCostCategories] -> ShowS
$cshowList :: [GetCostCategories] -> ShowS
show :: GetCostCategories -> String
$cshow :: GetCostCategories -> String
showsPrec :: Int -> GetCostCategories -> ShowS
$cshowsPrec :: Int -> GetCostCategories -> ShowS
Prelude.Show, forall x. Rep GetCostCategories x -> GetCostCategories
forall x. GetCostCategories -> Rep GetCostCategories x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetCostCategories x -> GetCostCategories
$cfrom :: forall x. GetCostCategories -> Rep GetCostCategories x
Prelude.Generic)

-- |
-- Create a value of 'GetCostCategories' 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:
--
-- 'costCategoryName', 'getCostCategories_costCategoryName' - Undocumented member.
--
-- 'filter'', 'getCostCategories_filter' - Undocumented member.
--
-- 'maxResults', 'getCostCategories_maxResults' - This field is only used when the @SortBy@ value is provided in the
-- request.
--
-- The maximum number of objects that are returned for this request. If
-- @MaxResults@ isn\'t specified with the @SortBy@ value, the request
-- returns 1000 results as the default value for this parameter.
--
-- For @GetCostCategories@, MaxResults has an upper quota of 1000.
--
-- 'nextPageToken', 'getCostCategories_nextPageToken' - If the number of objects that are still available for retrieval exceeds
-- the quota, Amazon Web Services returns a NextPageToken value in the
-- response. To retrieve the next batch of objects, provide the
-- NextPageToken from the previous call in your next request.
--
-- 'searchString', 'getCostCategories_searchString' - The value that you want to search the filter values for.
--
-- If you don\'t specify a @CostCategoryName@, @SearchString@ is used to
-- filter Cost Category names that match the @SearchString@ pattern. If you
-- specify a @CostCategoryName@, @SearchString@ is used to filter Cost
-- Category values that match the @SearchString@ pattern.
--
-- 'sortBy', 'getCostCategories_sortBy' - The value that you sort the data by.
--
-- The key represents the cost and usage metrics. The following values are
-- supported:
--
-- -   @BlendedCost@
--
-- -   @UnblendedCost@
--
-- -   @AmortizedCost@
--
-- -   @NetAmortizedCost@
--
-- -   @NetUnblendedCost@
--
-- -   @UsageQuantity@
--
-- -   @NormalizedUsageAmount@
--
-- The supported key values for the @SortOrder@ value are @ASCENDING@ and
-- @DESCENDING@.
--
-- When you use the @SortBy@ value, the @NextPageToken@ and @SearchString@
-- key values aren\'t supported.
--
-- 'timePeriod', 'getCostCategories_timePeriod' - Undocumented member.
newGetCostCategories ::
  -- | 'timePeriod'
  DateInterval ->
  GetCostCategories
newGetCostCategories :: DateInterval -> GetCostCategories
newGetCostCategories DateInterval
pTimePeriod_ =
  GetCostCategories'
    { $sel:costCategoryName:GetCostCategories' :: Maybe Text
costCategoryName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:filter':GetCostCategories' :: Maybe Expression
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetCostCategories' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:GetCostCategories' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:searchString:GetCostCategories' :: Maybe Text
searchString = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:GetCostCategories' :: Maybe [SortDefinition]
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:timePeriod:GetCostCategories' :: DateInterval
timePeriod = DateInterval
pTimePeriod_
    }

-- | Undocumented member.
getCostCategories_costCategoryName :: Lens.Lens' GetCostCategories (Prelude.Maybe Prelude.Text)
getCostCategories_costCategoryName :: Lens' GetCostCategories (Maybe Text)
getCostCategories_costCategoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategories' {Maybe Text
costCategoryName :: Maybe Text
$sel:costCategoryName:GetCostCategories' :: GetCostCategories -> Maybe Text
costCategoryName} -> Maybe Text
costCategoryName) (\s :: GetCostCategories
s@GetCostCategories' {} Maybe Text
a -> GetCostCategories
s {$sel:costCategoryName:GetCostCategories' :: Maybe Text
costCategoryName = Maybe Text
a} :: GetCostCategories)

-- | Undocumented member.
getCostCategories_filter :: Lens.Lens' GetCostCategories (Prelude.Maybe Expression)
getCostCategories_filter :: Lens' GetCostCategories (Maybe Expression)
getCostCategories_filter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategories' {Maybe Expression
filter' :: Maybe Expression
$sel:filter':GetCostCategories' :: GetCostCategories -> Maybe Expression
filter'} -> Maybe Expression
filter') (\s :: GetCostCategories
s@GetCostCategories' {} Maybe Expression
a -> GetCostCategories
s {$sel:filter':GetCostCategories' :: Maybe Expression
filter' = Maybe Expression
a} :: GetCostCategories)

-- | This field is only used when the @SortBy@ value is provided in the
-- request.
--
-- The maximum number of objects that are returned for this request. If
-- @MaxResults@ isn\'t specified with the @SortBy@ value, the request
-- returns 1000 results as the default value for this parameter.
--
-- For @GetCostCategories@, MaxResults has an upper quota of 1000.
getCostCategories_maxResults :: Lens.Lens' GetCostCategories (Prelude.Maybe Prelude.Natural)
getCostCategories_maxResults :: Lens' GetCostCategories (Maybe Natural)
getCostCategories_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategories' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetCostCategories' :: GetCostCategories -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetCostCategories
s@GetCostCategories' {} Maybe Natural
a -> GetCostCategories
s {$sel:maxResults:GetCostCategories' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetCostCategories)

-- | If the number of objects that are still available for retrieval exceeds
-- the quota, Amazon Web Services returns a NextPageToken value in the
-- response. To retrieve the next batch of objects, provide the
-- NextPageToken from the previous call in your next request.
getCostCategories_nextPageToken :: Lens.Lens' GetCostCategories (Prelude.Maybe Prelude.Text)
getCostCategories_nextPageToken :: Lens' GetCostCategories (Maybe Text)
getCostCategories_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategories' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetCostCategories' :: GetCostCategories -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetCostCategories
s@GetCostCategories' {} Maybe Text
a -> GetCostCategories
s {$sel:nextPageToken:GetCostCategories' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetCostCategories)

-- | The value that you want to search the filter values for.
--
-- If you don\'t specify a @CostCategoryName@, @SearchString@ is used to
-- filter Cost Category names that match the @SearchString@ pattern. If you
-- specify a @CostCategoryName@, @SearchString@ is used to filter Cost
-- Category values that match the @SearchString@ pattern.
getCostCategories_searchString :: Lens.Lens' GetCostCategories (Prelude.Maybe Prelude.Text)
getCostCategories_searchString :: Lens' GetCostCategories (Maybe Text)
getCostCategories_searchString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategories' {Maybe Text
searchString :: Maybe Text
$sel:searchString:GetCostCategories' :: GetCostCategories -> Maybe Text
searchString} -> Maybe Text
searchString) (\s :: GetCostCategories
s@GetCostCategories' {} Maybe Text
a -> GetCostCategories
s {$sel:searchString:GetCostCategories' :: Maybe Text
searchString = Maybe Text
a} :: GetCostCategories)

-- | The value that you sort the data by.
--
-- The key represents the cost and usage metrics. The following values are
-- supported:
--
-- -   @BlendedCost@
--
-- -   @UnblendedCost@
--
-- -   @AmortizedCost@
--
-- -   @NetAmortizedCost@
--
-- -   @NetUnblendedCost@
--
-- -   @UsageQuantity@
--
-- -   @NormalizedUsageAmount@
--
-- The supported key values for the @SortOrder@ value are @ASCENDING@ and
-- @DESCENDING@.
--
-- When you use the @SortBy@ value, the @NextPageToken@ and @SearchString@
-- key values aren\'t supported.
getCostCategories_sortBy :: Lens.Lens' GetCostCategories (Prelude.Maybe [SortDefinition])
getCostCategories_sortBy :: Lens' GetCostCategories (Maybe [SortDefinition])
getCostCategories_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategories' {Maybe [SortDefinition]
sortBy :: Maybe [SortDefinition]
$sel:sortBy:GetCostCategories' :: GetCostCategories -> Maybe [SortDefinition]
sortBy} -> Maybe [SortDefinition]
sortBy) (\s :: GetCostCategories
s@GetCostCategories' {} Maybe [SortDefinition]
a -> GetCostCategories
s {$sel:sortBy:GetCostCategories' :: Maybe [SortDefinition]
sortBy = Maybe [SortDefinition]
a} :: GetCostCategories) 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

-- | Undocumented member.
getCostCategories_timePeriod :: Lens.Lens' GetCostCategories DateInterval
getCostCategories_timePeriod :: Lens' GetCostCategories DateInterval
getCostCategories_timePeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategories' {DateInterval
timePeriod :: DateInterval
$sel:timePeriod:GetCostCategories' :: GetCostCategories -> DateInterval
timePeriod} -> DateInterval
timePeriod) (\s :: GetCostCategories
s@GetCostCategories' {} DateInterval
a -> GetCostCategories
s {$sel:timePeriod:GetCostCategories' :: DateInterval
timePeriod = DateInterval
a} :: GetCostCategories)

instance Core.AWSRequest GetCostCategories where
  type
    AWSResponse GetCostCategories =
      GetCostCategoriesResponse
  request :: (Service -> Service)
-> GetCostCategories -> Request GetCostCategories
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 GetCostCategories
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetCostCategories)))
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]
-> Maybe [Text]
-> Maybe Text
-> Int
-> Int
-> Int
-> GetCostCategoriesResponse
GetCostCategoriesResponse'
            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
"CostCategoryNames"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CostCategoryValues"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"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 a
Data..:> Key
"ReturnSize")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"TotalSize")
      )

instance Prelude.Hashable GetCostCategories where
  hashWithSalt :: Int -> GetCostCategories -> Int
hashWithSalt Int
_salt GetCostCategories' {Maybe Natural
Maybe [SortDefinition]
Maybe Text
Maybe Expression
DateInterval
timePeriod :: DateInterval
sortBy :: Maybe [SortDefinition]
searchString :: Maybe Text
nextPageToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe Expression
costCategoryName :: Maybe Text
$sel:timePeriod:GetCostCategories' :: GetCostCategories -> DateInterval
$sel:sortBy:GetCostCategories' :: GetCostCategories -> Maybe [SortDefinition]
$sel:searchString:GetCostCategories' :: GetCostCategories -> Maybe Text
$sel:nextPageToken:GetCostCategories' :: GetCostCategories -> Maybe Text
$sel:maxResults:GetCostCategories' :: GetCostCategories -> Maybe Natural
$sel:filter':GetCostCategories' :: GetCostCategories -> Maybe Expression
$sel:costCategoryName:GetCostCategories' :: GetCostCategories -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
costCategoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Expression
filter'
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextPageToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
searchString
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SortDefinition]
sortBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DateInterval
timePeriod

instance Prelude.NFData GetCostCategories where
  rnf :: GetCostCategories -> ()
rnf GetCostCategories' {Maybe Natural
Maybe [SortDefinition]
Maybe Text
Maybe Expression
DateInterval
timePeriod :: DateInterval
sortBy :: Maybe [SortDefinition]
searchString :: Maybe Text
nextPageToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe Expression
costCategoryName :: Maybe Text
$sel:timePeriod:GetCostCategories' :: GetCostCategories -> DateInterval
$sel:sortBy:GetCostCategories' :: GetCostCategories -> Maybe [SortDefinition]
$sel:searchString:GetCostCategories' :: GetCostCategories -> Maybe Text
$sel:nextPageToken:GetCostCategories' :: GetCostCategories -> Maybe Text
$sel:maxResults:GetCostCategories' :: GetCostCategories -> Maybe Natural
$sel:filter':GetCostCategories' :: GetCostCategories -> Maybe Expression
$sel:costCategoryName:GetCostCategories' :: GetCostCategories -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
costCategoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Expression
filter'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      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
searchString
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SortDefinition]
sortBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DateInterval
timePeriod

instance Data.ToHeaders GetCostCategories where
  toHeaders :: GetCostCategories -> 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.GetCostCategories" ::
                          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 GetCostCategories where
  toJSON :: GetCostCategories -> Value
toJSON GetCostCategories' {Maybe Natural
Maybe [SortDefinition]
Maybe Text
Maybe Expression
DateInterval
timePeriod :: DateInterval
sortBy :: Maybe [SortDefinition]
searchString :: Maybe Text
nextPageToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe Expression
costCategoryName :: Maybe Text
$sel:timePeriod:GetCostCategories' :: GetCostCategories -> DateInterval
$sel:sortBy:GetCostCategories' :: GetCostCategories -> Maybe [SortDefinition]
$sel:searchString:GetCostCategories' :: GetCostCategories -> Maybe Text
$sel:nextPageToken:GetCostCategories' :: GetCostCategories -> Maybe Text
$sel:maxResults:GetCostCategories' :: GetCostCategories -> Maybe Natural
$sel:filter':GetCostCategories' :: GetCostCategories -> Maybe Expression
$sel:costCategoryName:GetCostCategories' :: GetCostCategories -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CostCategoryName" 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
costCategoryName,
            (Key
"Filter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Expression
filter',
            (Key
"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 Natural
maxResults,
            (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
"SearchString" 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
searchString,
            (Key
"SortBy" 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 [SortDefinition]
sortBy,
            forall a. a -> Maybe a
Prelude.Just (Key
"TimePeriod" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DateInterval
timePeriod)
          ]
      )

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

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

-- | /See:/ 'newGetCostCategoriesResponse' smart constructor.
data GetCostCategoriesResponse = GetCostCategoriesResponse'
  { -- | The names of the Cost Categories.
    GetCostCategoriesResponse -> Maybe [Text]
costCategoryNames :: Prelude.Maybe [Prelude.Text],
    -- | The Cost Category values.
    --
    -- If the @CostCategoryName@ key isn\'t specified in the request, the
    -- @CostCategoryValues@ fields aren\'t returned.
    GetCostCategoriesResponse -> Maybe [Text]
costCategoryValues :: Prelude.Maybe [Prelude.Text],
    -- | If the number of objects that are still available for retrieval exceeds
    -- the quota, Amazon Web Services returns a NextPageToken value in the
    -- response. To retrieve the next batch of objects, provide the marker from
    -- the prior call in your next request.
    GetCostCategoriesResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetCostCategoriesResponse -> Int
httpStatus :: Prelude.Int,
    -- | The number of objects that are returned.
    GetCostCategoriesResponse -> Int
returnSize :: Prelude.Int,
    -- | The total number of objects.
    GetCostCategoriesResponse -> Int
totalSize :: Prelude.Int
  }
  deriving (GetCostCategoriesResponse -> GetCostCategoriesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetCostCategoriesResponse -> GetCostCategoriesResponse -> Bool
$c/= :: GetCostCategoriesResponse -> GetCostCategoriesResponse -> Bool
== :: GetCostCategoriesResponse -> GetCostCategoriesResponse -> Bool
$c== :: GetCostCategoriesResponse -> GetCostCategoriesResponse -> Bool
Prelude.Eq, ReadPrec [GetCostCategoriesResponse]
ReadPrec GetCostCategoriesResponse
Int -> ReadS GetCostCategoriesResponse
ReadS [GetCostCategoriesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetCostCategoriesResponse]
$creadListPrec :: ReadPrec [GetCostCategoriesResponse]
readPrec :: ReadPrec GetCostCategoriesResponse
$creadPrec :: ReadPrec GetCostCategoriesResponse
readList :: ReadS [GetCostCategoriesResponse]
$creadList :: ReadS [GetCostCategoriesResponse]
readsPrec :: Int -> ReadS GetCostCategoriesResponse
$creadsPrec :: Int -> ReadS GetCostCategoriesResponse
Prelude.Read, Int -> GetCostCategoriesResponse -> ShowS
[GetCostCategoriesResponse] -> ShowS
GetCostCategoriesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetCostCategoriesResponse] -> ShowS
$cshowList :: [GetCostCategoriesResponse] -> ShowS
show :: GetCostCategoriesResponse -> String
$cshow :: GetCostCategoriesResponse -> String
showsPrec :: Int -> GetCostCategoriesResponse -> ShowS
$cshowsPrec :: Int -> GetCostCategoriesResponse -> ShowS
Prelude.Show, forall x.
Rep GetCostCategoriesResponse x -> GetCostCategoriesResponse
forall x.
GetCostCategoriesResponse -> Rep GetCostCategoriesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetCostCategoriesResponse x -> GetCostCategoriesResponse
$cfrom :: forall x.
GetCostCategoriesResponse -> Rep GetCostCategoriesResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetCostCategoriesResponse' 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:
--
-- 'costCategoryNames', 'getCostCategoriesResponse_costCategoryNames' - The names of the Cost Categories.
--
-- 'costCategoryValues', 'getCostCategoriesResponse_costCategoryValues' - The Cost Category values.
--
-- If the @CostCategoryName@ key isn\'t specified in the request, the
-- @CostCategoryValues@ fields aren\'t returned.
--
-- 'nextPageToken', 'getCostCategoriesResponse_nextPageToken' - If the number of objects that are still available for retrieval exceeds
-- the quota, Amazon Web Services returns a NextPageToken value in the
-- response. To retrieve the next batch of objects, provide the marker from
-- the prior call in your next request.
--
-- 'httpStatus', 'getCostCategoriesResponse_httpStatus' - The response's http status code.
--
-- 'returnSize', 'getCostCategoriesResponse_returnSize' - The number of objects that are returned.
--
-- 'totalSize', 'getCostCategoriesResponse_totalSize' - The total number of objects.
newGetCostCategoriesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'returnSize'
  Prelude.Int ->
  -- | 'totalSize'
  Prelude.Int ->
  GetCostCategoriesResponse
newGetCostCategoriesResponse :: Int -> Int -> Int -> GetCostCategoriesResponse
newGetCostCategoriesResponse
  Int
pHttpStatus_
  Int
pReturnSize_
  Int
pTotalSize_ =
    GetCostCategoriesResponse'
      { $sel:costCategoryNames:GetCostCategoriesResponse' :: Maybe [Text]
costCategoryNames =
          forall a. Maybe a
Prelude.Nothing,
        $sel:costCategoryValues:GetCostCategoriesResponse' :: Maybe [Text]
costCategoryValues = forall a. Maybe a
Prelude.Nothing,
        $sel:nextPageToken:GetCostCategoriesResponse' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetCostCategoriesResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:returnSize:GetCostCategoriesResponse' :: Int
returnSize = Int
pReturnSize_,
        $sel:totalSize:GetCostCategoriesResponse' :: Int
totalSize = Int
pTotalSize_
      }

-- | The names of the Cost Categories.
getCostCategoriesResponse_costCategoryNames :: Lens.Lens' GetCostCategoriesResponse (Prelude.Maybe [Prelude.Text])
getCostCategoriesResponse_costCategoryNames :: Lens' GetCostCategoriesResponse (Maybe [Text])
getCostCategoriesResponse_costCategoryNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategoriesResponse' {Maybe [Text]
costCategoryNames :: Maybe [Text]
$sel:costCategoryNames:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Maybe [Text]
costCategoryNames} -> Maybe [Text]
costCategoryNames) (\s :: GetCostCategoriesResponse
s@GetCostCategoriesResponse' {} Maybe [Text]
a -> GetCostCategoriesResponse
s {$sel:costCategoryNames:GetCostCategoriesResponse' :: Maybe [Text]
costCategoryNames = Maybe [Text]
a} :: GetCostCategoriesResponse) 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

-- | The Cost Category values.
--
-- If the @CostCategoryName@ key isn\'t specified in the request, the
-- @CostCategoryValues@ fields aren\'t returned.
getCostCategoriesResponse_costCategoryValues :: Lens.Lens' GetCostCategoriesResponse (Prelude.Maybe [Prelude.Text])
getCostCategoriesResponse_costCategoryValues :: Lens' GetCostCategoriesResponse (Maybe [Text])
getCostCategoriesResponse_costCategoryValues = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategoriesResponse' {Maybe [Text]
costCategoryValues :: Maybe [Text]
$sel:costCategoryValues:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Maybe [Text]
costCategoryValues} -> Maybe [Text]
costCategoryValues) (\s :: GetCostCategoriesResponse
s@GetCostCategoriesResponse' {} Maybe [Text]
a -> GetCostCategoriesResponse
s {$sel:costCategoryValues:GetCostCategoriesResponse' :: Maybe [Text]
costCategoryValues = Maybe [Text]
a} :: GetCostCategoriesResponse) 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

-- | If the number of objects that are still available for retrieval exceeds
-- the quota, Amazon Web Services returns a NextPageToken value in the
-- response. To retrieve the next batch of objects, provide the marker from
-- the prior call in your next request.
getCostCategoriesResponse_nextPageToken :: Lens.Lens' GetCostCategoriesResponse (Prelude.Maybe Prelude.Text)
getCostCategoriesResponse_nextPageToken :: Lens' GetCostCategoriesResponse (Maybe Text)
getCostCategoriesResponse_nextPageToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategoriesResponse' {Maybe Text
nextPageToken :: Maybe Text
$sel:nextPageToken:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Maybe Text
nextPageToken} -> Maybe Text
nextPageToken) (\s :: GetCostCategoriesResponse
s@GetCostCategoriesResponse' {} Maybe Text
a -> GetCostCategoriesResponse
s {$sel:nextPageToken:GetCostCategoriesResponse' :: Maybe Text
nextPageToken = Maybe Text
a} :: GetCostCategoriesResponse)

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

-- | The number of objects that are returned.
getCostCategoriesResponse_returnSize :: Lens.Lens' GetCostCategoriesResponse Prelude.Int
getCostCategoriesResponse_returnSize :: Lens' GetCostCategoriesResponse Int
getCostCategoriesResponse_returnSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategoriesResponse' {Int
returnSize :: Int
$sel:returnSize:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Int
returnSize} -> Int
returnSize) (\s :: GetCostCategoriesResponse
s@GetCostCategoriesResponse' {} Int
a -> GetCostCategoriesResponse
s {$sel:returnSize:GetCostCategoriesResponse' :: Int
returnSize = Int
a} :: GetCostCategoriesResponse)

-- | The total number of objects.
getCostCategoriesResponse_totalSize :: Lens.Lens' GetCostCategoriesResponse Prelude.Int
getCostCategoriesResponse_totalSize :: Lens' GetCostCategoriesResponse Int
getCostCategoriesResponse_totalSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetCostCategoriesResponse' {Int
totalSize :: Int
$sel:totalSize:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Int
totalSize} -> Int
totalSize) (\s :: GetCostCategoriesResponse
s@GetCostCategoriesResponse' {} Int
a -> GetCostCategoriesResponse
s {$sel:totalSize:GetCostCategoriesResponse' :: Int
totalSize = Int
a} :: GetCostCategoriesResponse)

instance Prelude.NFData GetCostCategoriesResponse where
  rnf :: GetCostCategoriesResponse -> ()
rnf GetCostCategoriesResponse' {Int
Maybe [Text]
Maybe Text
totalSize :: Int
returnSize :: Int
httpStatus :: Int
nextPageToken :: Maybe Text
costCategoryValues :: Maybe [Text]
costCategoryNames :: Maybe [Text]
$sel:totalSize:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Int
$sel:returnSize:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Int
$sel:httpStatus:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Int
$sel:nextPageToken:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Maybe Text
$sel:costCategoryValues:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Maybe [Text]
$sel:costCategoryNames:GetCostCategoriesResponse' :: GetCostCategoriesResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
costCategoryNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
costCategoryValues
      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 Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
returnSize
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
totalSize