{-# 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.GetTags
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Queries for available tag keys and tag values for a specified period.
-- You can search the tag values for an arbitrary string.
module Amazonka.CostExplorer.GetTags
  ( -- * Creating a Request
    GetTags (..),
    newGetTags,

    -- * Request Lenses
    getTags_filter,
    getTags_maxResults,
    getTags_nextPageToken,
    getTags_searchString,
    getTags_sortBy,
    getTags_tagKey,
    getTags_timePeriod,

    -- * Destructuring the Response
    GetTagsResponse (..),
    newGetTagsResponse,

    -- * Response Lenses
    getTagsResponse_nextPageToken,
    getTagsResponse_httpStatus,
    getTagsResponse_tags,
    getTagsResponse_returnSize,
    getTagsResponse_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:/ 'newGetTags' smart constructor.
data GetTags = GetTags'
  { GetTags -> Maybe Expression
filter' :: Prelude.Maybe Expression,
    -- | This field is only used when SortBy is provided in the request. The
    -- maximum number of objects that are returned for this request. If
    -- MaxResults isn\'t specified with SortBy, the request returns 1000
    -- results as the default value for this parameter.
    --
    -- For @GetTags@, MaxResults has an upper quota of 1000.
    GetTags -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | 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.
    GetTags -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The value that you want to search for.
    GetTags -> Maybe Text
searchString :: Prelude.Maybe Prelude.Text,
    -- | The value that you want to sort the data by.
    --
    -- The key represents cost and usage metrics. The following values are
    -- supported:
    --
    -- -   @BlendedCost@
    --
    -- -   @UnblendedCost@
    --
    -- -   @AmortizedCost@
    --
    -- -   @NetAmortizedCost@
    --
    -- -   @NetUnblendedCost@
    --
    -- -   @UsageQuantity@
    --
    -- -   @NormalizedUsageAmount@
    --
    -- The supported values for @SortOrder@ are @ASCENDING@ and @DESCENDING@.
    --
    -- When you use @SortBy@, @NextPageToken@ and @SearchString@ aren\'t
    -- supported.
    GetTags -> Maybe [SortDefinition]
sortBy :: Prelude.Maybe [SortDefinition],
    -- | The key of the tag that you want to return values for.
    GetTags -> Maybe Text
tagKey :: Prelude.Maybe Prelude.Text,
    -- | The start and end dates for retrieving the dimension values. The start
    -- date is inclusive, but the end date is exclusive. For example, if
    -- @start@ is @2017-01-01@ and @end@ is @2017-05-01@, then the cost and
    -- usage data is retrieved from @2017-01-01@ up to and including
    -- @2017-04-30@ but not including @2017-05-01@.
    GetTags -> DateInterval
timePeriod :: DateInterval
  }
  deriving (GetTags -> GetTags -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTags -> GetTags -> Bool
$c/= :: GetTags -> GetTags -> Bool
== :: GetTags -> GetTags -> Bool
$c== :: GetTags -> GetTags -> Bool
Prelude.Eq, ReadPrec [GetTags]
ReadPrec GetTags
Int -> ReadS GetTags
ReadS [GetTags]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTags]
$creadListPrec :: ReadPrec [GetTags]
readPrec :: ReadPrec GetTags
$creadPrec :: ReadPrec GetTags
readList :: ReadS [GetTags]
$creadList :: ReadS [GetTags]
readsPrec :: Int -> ReadS GetTags
$creadsPrec :: Int -> ReadS GetTags
Prelude.Read, Int -> GetTags -> ShowS
[GetTags] -> ShowS
GetTags -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTags] -> ShowS
$cshowList :: [GetTags] -> ShowS
show :: GetTags -> String
$cshow :: GetTags -> String
showsPrec :: Int -> GetTags -> ShowS
$cshowsPrec :: Int -> GetTags -> ShowS
Prelude.Show, forall x. Rep GetTags x -> GetTags
forall x. GetTags -> Rep GetTags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTags x -> GetTags
$cfrom :: forall x. GetTags -> Rep GetTags x
Prelude.Generic)

-- |
-- Create a value of 'GetTags' 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:
--
-- 'filter'', 'getTags_filter' - Undocumented member.
--
-- 'maxResults', 'getTags_maxResults' - This field is only used when SortBy is provided in the request. The
-- maximum number of objects that are returned for this request. If
-- MaxResults isn\'t specified with SortBy, the request returns 1000
-- results as the default value for this parameter.
--
-- For @GetTags@, MaxResults has an upper quota of 1000.
--
-- 'nextPageToken', 'getTags_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.
--
-- 'searchString', 'getTags_searchString' - The value that you want to search for.
--
-- 'sortBy', 'getTags_sortBy' - The value that you want to sort the data by.
--
-- The key represents cost and usage metrics. The following values are
-- supported:
--
-- -   @BlendedCost@
--
-- -   @UnblendedCost@
--
-- -   @AmortizedCost@
--
-- -   @NetAmortizedCost@
--
-- -   @NetUnblendedCost@
--
-- -   @UsageQuantity@
--
-- -   @NormalizedUsageAmount@
--
-- The supported values for @SortOrder@ are @ASCENDING@ and @DESCENDING@.
--
-- When you use @SortBy@, @NextPageToken@ and @SearchString@ aren\'t
-- supported.
--
-- 'tagKey', 'getTags_tagKey' - The key of the tag that you want to return values for.
--
-- 'timePeriod', 'getTags_timePeriod' - The start and end dates for retrieving the dimension values. The start
-- date is inclusive, but the end date is exclusive. For example, if
-- @start@ is @2017-01-01@ and @end@ is @2017-05-01@, then the cost and
-- usage data is retrieved from @2017-01-01@ up to and including
-- @2017-04-30@ but not including @2017-05-01@.
newGetTags ::
  -- | 'timePeriod'
  DateInterval ->
  GetTags
newGetTags :: DateInterval -> GetTags
newGetTags DateInterval
pTimePeriod_ =
  GetTags'
    { $sel:filter':GetTags' :: Maybe Expression
filter' = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetTags' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextPageToken:GetTags' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
      $sel:searchString:GetTags' :: Maybe Text
searchString = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:GetTags' :: Maybe [SortDefinition]
sortBy = forall a. Maybe a
Prelude.Nothing,
      $sel:tagKey:GetTags' :: Maybe Text
tagKey = forall a. Maybe a
Prelude.Nothing,
      $sel:timePeriod:GetTags' :: DateInterval
timePeriod = DateInterval
pTimePeriod_
    }

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

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

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

-- | The value that you want to search for.
getTags_searchString :: Lens.Lens' GetTags (Prelude.Maybe Prelude.Text)
getTags_searchString :: Lens' GetTags (Maybe Text)
getTags_searchString = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTags' {Maybe Text
searchString :: Maybe Text
$sel:searchString:GetTags' :: GetTags -> Maybe Text
searchString} -> Maybe Text
searchString) (\s :: GetTags
s@GetTags' {} Maybe Text
a -> GetTags
s {$sel:searchString:GetTags' :: Maybe Text
searchString = Maybe Text
a} :: GetTags)

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

-- | The start and end dates for retrieving the dimension values. The start
-- date is inclusive, but the end date is exclusive. For example, if
-- @start@ is @2017-01-01@ and @end@ is @2017-05-01@, then the cost and
-- usage data is retrieved from @2017-01-01@ up to and including
-- @2017-04-30@ but not including @2017-05-01@.
getTags_timePeriod :: Lens.Lens' GetTags DateInterval
getTags_timePeriod :: Lens' GetTags DateInterval
getTags_timePeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTags' {DateInterval
timePeriod :: DateInterval
$sel:timePeriod:GetTags' :: GetTags -> DateInterval
timePeriod} -> DateInterval
timePeriod) (\s :: GetTags
s@GetTags' {} DateInterval
a -> GetTags
s {$sel:timePeriod:GetTags' :: DateInterval
timePeriod = DateInterval
a} :: GetTags)

instance Core.AWSRequest GetTags where
  type AWSResponse GetTags = GetTagsResponse
  request :: (Service -> Service) -> GetTags -> Request GetTags
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 GetTags
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTags)))
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 -> [Text] -> Int -> Int -> GetTagsResponse
GetTagsResponse'
            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
"Tags" 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 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 GetTags where
  hashWithSalt :: Int -> GetTags -> Int
hashWithSalt Int
_salt GetTags' {Maybe Natural
Maybe [SortDefinition]
Maybe Text
Maybe Expression
DateInterval
timePeriod :: DateInterval
tagKey :: Maybe Text
sortBy :: Maybe [SortDefinition]
searchString :: Maybe Text
nextPageToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe Expression
$sel:timePeriod:GetTags' :: GetTags -> DateInterval
$sel:tagKey:GetTags' :: GetTags -> Maybe Text
$sel:sortBy:GetTags' :: GetTags -> Maybe [SortDefinition]
$sel:searchString:GetTags' :: GetTags -> Maybe Text
$sel:nextPageToken:GetTags' :: GetTags -> Maybe Text
$sel:maxResults:GetTags' :: GetTags -> Maybe Natural
$sel:filter':GetTags' :: GetTags -> Maybe Expression
..} =
    Int
_salt
      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` Maybe Text
tagKey
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DateInterval
timePeriod

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

instance Data.ToHeaders GetTags where
  toHeaders :: GetTags -> 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.GetTags" ::
                          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 GetTags where
  toJSON :: GetTags -> Value
toJSON GetTags' {Maybe Natural
Maybe [SortDefinition]
Maybe Text
Maybe Expression
DateInterval
timePeriod :: DateInterval
tagKey :: Maybe Text
sortBy :: Maybe [SortDefinition]
searchString :: Maybe Text
nextPageToken :: Maybe Text
maxResults :: Maybe Natural
filter' :: Maybe Expression
$sel:timePeriod:GetTags' :: GetTags -> DateInterval
$sel:tagKey:GetTags' :: GetTags -> Maybe Text
$sel:sortBy:GetTags' :: GetTags -> Maybe [SortDefinition]
$sel:searchString:GetTags' :: GetTags -> Maybe Text
$sel:nextPageToken:GetTags' :: GetTags -> Maybe Text
$sel:maxResults:GetTags' :: GetTags -> Maybe Natural
$sel:filter':GetTags' :: GetTags -> Maybe Expression
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            (Key
"TagKey" 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
tagKey,
            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 GetTags where
  toPath :: GetTags -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetTagsResponse' smart constructor.
data GetTagsResponse = GetTagsResponse'
  { -- | The token for the next set of retrievable results. Amazon Web Services
    -- provides the token when the response from a previous call has more
    -- results than the maximum page size.
    GetTagsResponse -> Maybe Text
nextPageToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetTagsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The tags that match your request.
    GetTagsResponse -> [Text]
tags :: [Prelude.Text],
    -- | The number of query results that Amazon Web Services returns at a time.
    GetTagsResponse -> Int
returnSize :: Prelude.Int,
    -- | The total number of query results.
    GetTagsResponse -> Int
totalSize :: Prelude.Int
  }
  deriving (GetTagsResponse -> GetTagsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTagsResponse -> GetTagsResponse -> Bool
$c/= :: GetTagsResponse -> GetTagsResponse -> Bool
== :: GetTagsResponse -> GetTagsResponse -> Bool
$c== :: GetTagsResponse -> GetTagsResponse -> Bool
Prelude.Eq, ReadPrec [GetTagsResponse]
ReadPrec GetTagsResponse
Int -> ReadS GetTagsResponse
ReadS [GetTagsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTagsResponse]
$creadListPrec :: ReadPrec [GetTagsResponse]
readPrec :: ReadPrec GetTagsResponse
$creadPrec :: ReadPrec GetTagsResponse
readList :: ReadS [GetTagsResponse]
$creadList :: ReadS [GetTagsResponse]
readsPrec :: Int -> ReadS GetTagsResponse
$creadsPrec :: Int -> ReadS GetTagsResponse
Prelude.Read, Int -> GetTagsResponse -> ShowS
[GetTagsResponse] -> ShowS
GetTagsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTagsResponse] -> ShowS
$cshowList :: [GetTagsResponse] -> ShowS
show :: GetTagsResponse -> String
$cshow :: GetTagsResponse -> String
showsPrec :: Int -> GetTagsResponse -> ShowS
$cshowsPrec :: Int -> GetTagsResponse -> ShowS
Prelude.Show, forall x. Rep GetTagsResponse x -> GetTagsResponse
forall x. GetTagsResponse -> Rep GetTagsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTagsResponse x -> GetTagsResponse
$cfrom :: forall x. GetTagsResponse -> Rep GetTagsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTagsResponse' 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', 'getTagsResponse_nextPageToken' - The token for the next set of retrievable results. Amazon Web Services
-- provides the token when the response from a previous call has more
-- results than the maximum page size.
--
-- 'httpStatus', 'getTagsResponse_httpStatus' - The response's http status code.
--
-- 'tags', 'getTagsResponse_tags' - The tags that match your request.
--
-- 'returnSize', 'getTagsResponse_returnSize' - The number of query results that Amazon Web Services returns at a time.
--
-- 'totalSize', 'getTagsResponse_totalSize' - The total number of query results.
newGetTagsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'returnSize'
  Prelude.Int ->
  -- | 'totalSize'
  Prelude.Int ->
  GetTagsResponse
newGetTagsResponse :: Int -> Int -> Int -> GetTagsResponse
newGetTagsResponse
  Int
pHttpStatus_
  Int
pReturnSize_
  Int
pTotalSize_ =
    GetTagsResponse'
      { $sel:nextPageToken:GetTagsResponse' :: Maybe Text
nextPageToken = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:GetTagsResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:tags:GetTagsResponse' :: [Text]
tags = forall a. Monoid a => a
Prelude.mempty,
        $sel:returnSize:GetTagsResponse' :: Int
returnSize = Int
pReturnSize_,
        $sel:totalSize:GetTagsResponse' :: Int
totalSize = Int
pTotalSize_
      }

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

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

-- | The tags that match your request.
getTagsResponse_tags :: Lens.Lens' GetTagsResponse [Prelude.Text]
getTagsResponse_tags :: Lens' GetTagsResponse [Text]
getTagsResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTagsResponse' {[Text]
tags :: [Text]
$sel:tags:GetTagsResponse' :: GetTagsResponse -> [Text]
tags} -> [Text]
tags) (\s :: GetTagsResponse
s@GetTagsResponse' {} [Text]
a -> GetTagsResponse
s {$sel:tags:GetTagsResponse' :: [Text]
tags = [Text]
a} :: GetTagsResponse) 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

-- | The number of query results that Amazon Web Services returns at a time.
getTagsResponse_returnSize :: Lens.Lens' GetTagsResponse Prelude.Int
getTagsResponse_returnSize :: Lens' GetTagsResponse Int
getTagsResponse_returnSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTagsResponse' {Int
returnSize :: Int
$sel:returnSize:GetTagsResponse' :: GetTagsResponse -> Int
returnSize} -> Int
returnSize) (\s :: GetTagsResponse
s@GetTagsResponse' {} Int
a -> GetTagsResponse
s {$sel:returnSize:GetTagsResponse' :: Int
returnSize = Int
a} :: GetTagsResponse)

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

instance Prelude.NFData GetTagsResponse where
  rnf :: GetTagsResponse -> ()
rnf GetTagsResponse' {Int
[Text]
Maybe Text
totalSize :: Int
returnSize :: Int
tags :: [Text]
httpStatus :: Int
nextPageToken :: Maybe Text
$sel:totalSize:GetTagsResponse' :: GetTagsResponse -> Int
$sel:returnSize:GetTagsResponse' :: GetTagsResponse -> Int
$sel:tags:GetTagsResponse' :: GetTagsResponse -> [Text]
$sel:httpStatus:GetTagsResponse' :: GetTagsResponse -> Int
$sel:nextPageToken:GetTagsResponse' :: GetTagsResponse -> 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 [Text]
tags
      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