{-# 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.IoT.ListMetricValues
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the values reported for an IoT Device Defender metric (device-side
-- metric, cloud-side metric, or custom metric) by the given thing during
-- the specified time period.
--
-- This operation returns paginated results.
module Amazonka.IoT.ListMetricValues
  ( -- * Creating a Request
    ListMetricValues (..),
    newListMetricValues,

    -- * Request Lenses
    listMetricValues_dimensionName,
    listMetricValues_dimensionValueOperator,
    listMetricValues_maxResults,
    listMetricValues_nextToken,
    listMetricValues_thingName,
    listMetricValues_metricName,
    listMetricValues_startTime,
    listMetricValues_endTime,

    -- * Destructuring the Response
    ListMetricValuesResponse (..),
    newListMetricValuesResponse,

    -- * Response Lenses
    listMetricValuesResponse_metricDatumList,
    listMetricValuesResponse_nextToken,
    listMetricValuesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListMetricValues' smart constructor.
data ListMetricValues = ListMetricValues'
  { -- | The dimension name.
    ListMetricValues -> Maybe Text
dimensionName :: Prelude.Maybe Prelude.Text,
    -- | The dimension value operator.
    ListMetricValues -> Maybe DimensionValueOperator
dimensionValueOperator :: Prelude.Maybe DimensionValueOperator,
    -- | The maximum number of results to return at one time.
    ListMetricValues -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token for the next set of results.
    ListMetricValues -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the thing for which security profile metric values are
    -- returned.
    ListMetricValues -> Text
thingName :: Prelude.Text,
    -- | The name of the security profile metric for which values are returned.
    ListMetricValues -> Text
metricName :: Prelude.Text,
    -- | The start of the time period for which metric values are returned.
    ListMetricValues -> POSIX
startTime :: Data.POSIX,
    -- | The end of the time period for which metric values are returned.
    ListMetricValues -> POSIX
endTime :: Data.POSIX
  }
  deriving (ListMetricValues -> ListMetricValues -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMetricValues -> ListMetricValues -> Bool
$c/= :: ListMetricValues -> ListMetricValues -> Bool
== :: ListMetricValues -> ListMetricValues -> Bool
$c== :: ListMetricValues -> ListMetricValues -> Bool
Prelude.Eq, ReadPrec [ListMetricValues]
ReadPrec ListMetricValues
Int -> ReadS ListMetricValues
ReadS [ListMetricValues]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMetricValues]
$creadListPrec :: ReadPrec [ListMetricValues]
readPrec :: ReadPrec ListMetricValues
$creadPrec :: ReadPrec ListMetricValues
readList :: ReadS [ListMetricValues]
$creadList :: ReadS [ListMetricValues]
readsPrec :: Int -> ReadS ListMetricValues
$creadsPrec :: Int -> ReadS ListMetricValues
Prelude.Read, Int -> ListMetricValues -> ShowS
[ListMetricValues] -> ShowS
ListMetricValues -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMetricValues] -> ShowS
$cshowList :: [ListMetricValues] -> ShowS
show :: ListMetricValues -> String
$cshow :: ListMetricValues -> String
showsPrec :: Int -> ListMetricValues -> ShowS
$cshowsPrec :: Int -> ListMetricValues -> ShowS
Prelude.Show, forall x. Rep ListMetricValues x -> ListMetricValues
forall x. ListMetricValues -> Rep ListMetricValues x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListMetricValues x -> ListMetricValues
$cfrom :: forall x. ListMetricValues -> Rep ListMetricValues x
Prelude.Generic)

-- |
-- Create a value of 'ListMetricValues' 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:
--
-- 'dimensionName', 'listMetricValues_dimensionName' - The dimension name.
--
-- 'dimensionValueOperator', 'listMetricValues_dimensionValueOperator' - The dimension value operator.
--
-- 'maxResults', 'listMetricValues_maxResults' - The maximum number of results to return at one time.
--
-- 'nextToken', 'listMetricValues_nextToken' - The token for the next set of results.
--
-- 'thingName', 'listMetricValues_thingName' - The name of the thing for which security profile metric values are
-- returned.
--
-- 'metricName', 'listMetricValues_metricName' - The name of the security profile metric for which values are returned.
--
-- 'startTime', 'listMetricValues_startTime' - The start of the time period for which metric values are returned.
--
-- 'endTime', 'listMetricValues_endTime' - The end of the time period for which metric values are returned.
newListMetricValues ::
  -- | 'thingName'
  Prelude.Text ->
  -- | 'metricName'
  Prelude.Text ->
  -- | 'startTime'
  Prelude.UTCTime ->
  -- | 'endTime'
  Prelude.UTCTime ->
  ListMetricValues
newListMetricValues :: Text -> Text -> UTCTime -> UTCTime -> ListMetricValues
newListMetricValues
  Text
pThingName_
  Text
pMetricName_
  UTCTime
pStartTime_
  UTCTime
pEndTime_ =
    ListMetricValues'
      { $sel:dimensionName:ListMetricValues' :: Maybe Text
dimensionName = forall a. Maybe a
Prelude.Nothing,
        $sel:dimensionValueOperator:ListMetricValues' :: Maybe DimensionValueOperator
dimensionValueOperator = forall a. Maybe a
Prelude.Nothing,
        $sel:maxResults:ListMetricValues' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListMetricValues' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:thingName:ListMetricValues' :: Text
thingName = Text
pThingName_,
        $sel:metricName:ListMetricValues' :: Text
metricName = Text
pMetricName_,
        $sel:startTime:ListMetricValues' :: POSIX
startTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pStartTime_,
        $sel:endTime:ListMetricValues' :: POSIX
endTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pEndTime_
      }

-- | The dimension name.
listMetricValues_dimensionName :: Lens.Lens' ListMetricValues (Prelude.Maybe Prelude.Text)
listMetricValues_dimensionName :: Lens' ListMetricValues (Maybe Text)
listMetricValues_dimensionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValues' {Maybe Text
dimensionName :: Maybe Text
$sel:dimensionName:ListMetricValues' :: ListMetricValues -> Maybe Text
dimensionName} -> Maybe Text
dimensionName) (\s :: ListMetricValues
s@ListMetricValues' {} Maybe Text
a -> ListMetricValues
s {$sel:dimensionName:ListMetricValues' :: Maybe Text
dimensionName = Maybe Text
a} :: ListMetricValues)

-- | The dimension value operator.
listMetricValues_dimensionValueOperator :: Lens.Lens' ListMetricValues (Prelude.Maybe DimensionValueOperator)
listMetricValues_dimensionValueOperator :: Lens' ListMetricValues (Maybe DimensionValueOperator)
listMetricValues_dimensionValueOperator = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValues' {Maybe DimensionValueOperator
dimensionValueOperator :: Maybe DimensionValueOperator
$sel:dimensionValueOperator:ListMetricValues' :: ListMetricValues -> Maybe DimensionValueOperator
dimensionValueOperator} -> Maybe DimensionValueOperator
dimensionValueOperator) (\s :: ListMetricValues
s@ListMetricValues' {} Maybe DimensionValueOperator
a -> ListMetricValues
s {$sel:dimensionValueOperator:ListMetricValues' :: Maybe DimensionValueOperator
dimensionValueOperator = Maybe DimensionValueOperator
a} :: ListMetricValues)

-- | The maximum number of results to return at one time.
listMetricValues_maxResults :: Lens.Lens' ListMetricValues (Prelude.Maybe Prelude.Natural)
listMetricValues_maxResults :: Lens' ListMetricValues (Maybe Natural)
listMetricValues_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValues' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListMetricValues' :: ListMetricValues -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListMetricValues
s@ListMetricValues' {} Maybe Natural
a -> ListMetricValues
s {$sel:maxResults:ListMetricValues' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListMetricValues)

-- | The token for the next set of results.
listMetricValues_nextToken :: Lens.Lens' ListMetricValues (Prelude.Maybe Prelude.Text)
listMetricValues_nextToken :: Lens' ListMetricValues (Maybe Text)
listMetricValues_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValues' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListMetricValues' :: ListMetricValues -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListMetricValues
s@ListMetricValues' {} Maybe Text
a -> ListMetricValues
s {$sel:nextToken:ListMetricValues' :: Maybe Text
nextToken = Maybe Text
a} :: ListMetricValues)

-- | The name of the thing for which security profile metric values are
-- returned.
listMetricValues_thingName :: Lens.Lens' ListMetricValues Prelude.Text
listMetricValues_thingName :: Lens' ListMetricValues Text
listMetricValues_thingName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValues' {Text
thingName :: Text
$sel:thingName:ListMetricValues' :: ListMetricValues -> Text
thingName} -> Text
thingName) (\s :: ListMetricValues
s@ListMetricValues' {} Text
a -> ListMetricValues
s {$sel:thingName:ListMetricValues' :: Text
thingName = Text
a} :: ListMetricValues)

-- | The name of the security profile metric for which values are returned.
listMetricValues_metricName :: Lens.Lens' ListMetricValues Prelude.Text
listMetricValues_metricName :: Lens' ListMetricValues Text
listMetricValues_metricName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValues' {Text
metricName :: Text
$sel:metricName:ListMetricValues' :: ListMetricValues -> Text
metricName} -> Text
metricName) (\s :: ListMetricValues
s@ListMetricValues' {} Text
a -> ListMetricValues
s {$sel:metricName:ListMetricValues' :: Text
metricName = Text
a} :: ListMetricValues)

-- | The start of the time period for which metric values are returned.
listMetricValues_startTime :: Lens.Lens' ListMetricValues Prelude.UTCTime
listMetricValues_startTime :: Lens' ListMetricValues UTCTime
listMetricValues_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValues' {POSIX
startTime :: POSIX
$sel:startTime:ListMetricValues' :: ListMetricValues -> POSIX
startTime} -> POSIX
startTime) (\s :: ListMetricValues
s@ListMetricValues' {} POSIX
a -> ListMetricValues
s {$sel:startTime:ListMetricValues' :: POSIX
startTime = POSIX
a} :: ListMetricValues) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The end of the time period for which metric values are returned.
listMetricValues_endTime :: Lens.Lens' ListMetricValues Prelude.UTCTime
listMetricValues_endTime :: Lens' ListMetricValues UTCTime
listMetricValues_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValues' {POSIX
endTime :: POSIX
$sel:endTime:ListMetricValues' :: ListMetricValues -> POSIX
endTime} -> POSIX
endTime) (\s :: ListMetricValues
s@ListMetricValues' {} POSIX
a -> ListMetricValues
s {$sel:endTime:ListMetricValues' :: POSIX
endTime = POSIX
a} :: ListMetricValues) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSPager ListMetricValues where
  page :: ListMetricValues
-> AWSResponse ListMetricValues -> Maybe ListMetricValues
page ListMetricValues
rq AWSResponse ListMetricValues
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListMetricValues
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMetricValuesResponse (Maybe Text)
listMetricValuesResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListMetricValues
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMetricValuesResponse (Maybe [MetricDatum])
listMetricValuesResponse_metricDatumList
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListMetricValues
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListMetricValues (Maybe Text)
listMetricValues_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListMetricValues
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListMetricValuesResponse (Maybe Text)
listMetricValuesResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListMetricValues where
  type
    AWSResponse ListMetricValues =
      ListMetricValuesResponse
  request :: (Service -> Service)
-> ListMetricValues -> Request ListMetricValues
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListMetricValues
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListMetricValues)))
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 [MetricDatum]
-> Maybe Text -> Int -> ListMetricValuesResponse
ListMetricValuesResponse'
            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
"metricDatumList"
                            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
"nextToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListMetricValues where
  hashWithSalt :: Int -> ListMetricValues -> Int
hashWithSalt Int
_salt ListMetricValues' {Maybe Natural
Maybe Text
Maybe DimensionValueOperator
Text
POSIX
endTime :: POSIX
startTime :: POSIX
metricName :: Text
thingName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
dimensionValueOperator :: Maybe DimensionValueOperator
dimensionName :: Maybe Text
$sel:endTime:ListMetricValues' :: ListMetricValues -> POSIX
$sel:startTime:ListMetricValues' :: ListMetricValues -> POSIX
$sel:metricName:ListMetricValues' :: ListMetricValues -> Text
$sel:thingName:ListMetricValues' :: ListMetricValues -> Text
$sel:nextToken:ListMetricValues' :: ListMetricValues -> Maybe Text
$sel:maxResults:ListMetricValues' :: ListMetricValues -> Maybe Natural
$sel:dimensionValueOperator:ListMetricValues' :: ListMetricValues -> Maybe DimensionValueOperator
$sel:dimensionName:ListMetricValues' :: ListMetricValues -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
dimensionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DimensionValueOperator
dimensionValueOperator
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
thingName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
metricName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
startTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
endTime

instance Prelude.NFData ListMetricValues where
  rnf :: ListMetricValues -> ()
rnf ListMetricValues' {Maybe Natural
Maybe Text
Maybe DimensionValueOperator
Text
POSIX
endTime :: POSIX
startTime :: POSIX
metricName :: Text
thingName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
dimensionValueOperator :: Maybe DimensionValueOperator
dimensionName :: Maybe Text
$sel:endTime:ListMetricValues' :: ListMetricValues -> POSIX
$sel:startTime:ListMetricValues' :: ListMetricValues -> POSIX
$sel:metricName:ListMetricValues' :: ListMetricValues -> Text
$sel:thingName:ListMetricValues' :: ListMetricValues -> Text
$sel:nextToken:ListMetricValues' :: ListMetricValues -> Maybe Text
$sel:maxResults:ListMetricValues' :: ListMetricValues -> Maybe Natural
$sel:dimensionValueOperator:ListMetricValues' :: ListMetricValues -> Maybe DimensionValueOperator
$sel:dimensionName:ListMetricValues' :: ListMetricValues -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
dimensionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DimensionValueOperator
dimensionValueOperator
      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
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
thingName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
metricName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
startTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
endTime

instance Data.ToHeaders ListMetricValues where
  toHeaders :: ListMetricValues -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ListMetricValues where
  toQuery :: ListMetricValues -> QueryString
toQuery ListMetricValues' {Maybe Natural
Maybe Text
Maybe DimensionValueOperator
Text
POSIX
endTime :: POSIX
startTime :: POSIX
metricName :: Text
thingName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
dimensionValueOperator :: Maybe DimensionValueOperator
dimensionName :: Maybe Text
$sel:endTime:ListMetricValues' :: ListMetricValues -> POSIX
$sel:startTime:ListMetricValues' :: ListMetricValues -> POSIX
$sel:metricName:ListMetricValues' :: ListMetricValues -> Text
$sel:thingName:ListMetricValues' :: ListMetricValues -> Text
$sel:nextToken:ListMetricValues' :: ListMetricValues -> Maybe Text
$sel:maxResults:ListMetricValues' :: ListMetricValues -> Maybe Natural
$sel:dimensionValueOperator:ListMetricValues' :: ListMetricValues -> Maybe DimensionValueOperator
$sel:dimensionName:ListMetricValues' :: ListMetricValues -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"dimensionName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
dimensionName,
        ByteString
"dimensionValueOperator"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DimensionValueOperator
dimensionValueOperator,
        ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"thingName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
thingName,
        ByteString
"metricName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
metricName,
        ByteString
"startTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: POSIX
startTime,
        ByteString
"endTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: POSIX
endTime
      ]

-- | /See:/ 'newListMetricValuesResponse' smart constructor.
data ListMetricValuesResponse = ListMetricValuesResponse'
  { -- | The data the thing reports for the metric during the specified time
    -- period.
    ListMetricValuesResponse -> Maybe [MetricDatum]
metricDatumList :: Prelude.Maybe [MetricDatum],
    -- | A token that can be used to retrieve the next set of results, or @null@
    -- if there are no additional results.
    ListMetricValuesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListMetricValuesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListMetricValuesResponse -> ListMetricValuesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListMetricValuesResponse -> ListMetricValuesResponse -> Bool
$c/= :: ListMetricValuesResponse -> ListMetricValuesResponse -> Bool
== :: ListMetricValuesResponse -> ListMetricValuesResponse -> Bool
$c== :: ListMetricValuesResponse -> ListMetricValuesResponse -> Bool
Prelude.Eq, ReadPrec [ListMetricValuesResponse]
ReadPrec ListMetricValuesResponse
Int -> ReadS ListMetricValuesResponse
ReadS [ListMetricValuesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListMetricValuesResponse]
$creadListPrec :: ReadPrec [ListMetricValuesResponse]
readPrec :: ReadPrec ListMetricValuesResponse
$creadPrec :: ReadPrec ListMetricValuesResponse
readList :: ReadS [ListMetricValuesResponse]
$creadList :: ReadS [ListMetricValuesResponse]
readsPrec :: Int -> ReadS ListMetricValuesResponse
$creadsPrec :: Int -> ReadS ListMetricValuesResponse
Prelude.Read, Int -> ListMetricValuesResponse -> ShowS
[ListMetricValuesResponse] -> ShowS
ListMetricValuesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListMetricValuesResponse] -> ShowS
$cshowList :: [ListMetricValuesResponse] -> ShowS
show :: ListMetricValuesResponse -> String
$cshow :: ListMetricValuesResponse -> String
showsPrec :: Int -> ListMetricValuesResponse -> ShowS
$cshowsPrec :: Int -> ListMetricValuesResponse -> ShowS
Prelude.Show, forall x.
Rep ListMetricValuesResponse x -> ListMetricValuesResponse
forall x.
ListMetricValuesResponse -> Rep ListMetricValuesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListMetricValuesResponse x -> ListMetricValuesResponse
$cfrom :: forall x.
ListMetricValuesResponse -> Rep ListMetricValuesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListMetricValuesResponse' 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:
--
-- 'metricDatumList', 'listMetricValuesResponse_metricDatumList' - The data the thing reports for the metric during the specified time
-- period.
--
-- 'nextToken', 'listMetricValuesResponse_nextToken' - A token that can be used to retrieve the next set of results, or @null@
-- if there are no additional results.
--
-- 'httpStatus', 'listMetricValuesResponse_httpStatus' - The response's http status code.
newListMetricValuesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListMetricValuesResponse
newListMetricValuesResponse :: Int -> ListMetricValuesResponse
newListMetricValuesResponse Int
pHttpStatus_ =
  ListMetricValuesResponse'
    { $sel:metricDatumList:ListMetricValuesResponse' :: Maybe [MetricDatum]
metricDatumList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListMetricValuesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListMetricValuesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The data the thing reports for the metric during the specified time
-- period.
listMetricValuesResponse_metricDatumList :: Lens.Lens' ListMetricValuesResponse (Prelude.Maybe [MetricDatum])
listMetricValuesResponse_metricDatumList :: Lens' ListMetricValuesResponse (Maybe [MetricDatum])
listMetricValuesResponse_metricDatumList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValuesResponse' {Maybe [MetricDatum]
metricDatumList :: Maybe [MetricDatum]
$sel:metricDatumList:ListMetricValuesResponse' :: ListMetricValuesResponse -> Maybe [MetricDatum]
metricDatumList} -> Maybe [MetricDatum]
metricDatumList) (\s :: ListMetricValuesResponse
s@ListMetricValuesResponse' {} Maybe [MetricDatum]
a -> ListMetricValuesResponse
s {$sel:metricDatumList:ListMetricValuesResponse' :: Maybe [MetricDatum]
metricDatumList = Maybe [MetricDatum]
a} :: ListMetricValuesResponse) 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

-- | A token that can be used to retrieve the next set of results, or @null@
-- if there are no additional results.
listMetricValuesResponse_nextToken :: Lens.Lens' ListMetricValuesResponse (Prelude.Maybe Prelude.Text)
listMetricValuesResponse_nextToken :: Lens' ListMetricValuesResponse (Maybe Text)
listMetricValuesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListMetricValuesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListMetricValuesResponse' :: ListMetricValuesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListMetricValuesResponse
s@ListMetricValuesResponse' {} Maybe Text
a -> ListMetricValuesResponse
s {$sel:nextToken:ListMetricValuesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListMetricValuesResponse)

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

instance Prelude.NFData ListMetricValuesResponse where
  rnf :: ListMetricValuesResponse -> ()
rnf ListMetricValuesResponse' {Int
Maybe [MetricDatum]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
metricDatumList :: Maybe [MetricDatum]
$sel:httpStatus:ListMetricValuesResponse' :: ListMetricValuesResponse -> Int
$sel:nextToken:ListMetricValuesResponse' :: ListMetricValuesResponse -> Maybe Text
$sel:metricDatumList:ListMetricValuesResponse' :: ListMetricValuesResponse -> Maybe [MetricDatum]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MetricDatum]
metricDatumList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus