{-# 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.EC2.GetAwsNetworkPerformanceData
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets network performance data.
--
-- This operation returns paginated results.
module Amazonka.EC2.GetAwsNetworkPerformanceData
  ( -- * Creating a Request
    GetAwsNetworkPerformanceData (..),
    newGetAwsNetworkPerformanceData,

    -- * Request Lenses
    getAwsNetworkPerformanceData_dataQueries,
    getAwsNetworkPerformanceData_dryRun,
    getAwsNetworkPerformanceData_endTime,
    getAwsNetworkPerformanceData_maxResults,
    getAwsNetworkPerformanceData_nextToken,
    getAwsNetworkPerformanceData_startTime,

    -- * Destructuring the Response
    GetAwsNetworkPerformanceDataResponse (..),
    newGetAwsNetworkPerformanceDataResponse,

    -- * Response Lenses
    getAwsNetworkPerformanceDataResponse_dataResponses,
    getAwsNetworkPerformanceDataResponse_nextToken,
    getAwsNetworkPerformanceDataResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetAwsNetworkPerformanceData' smart constructor.
data GetAwsNetworkPerformanceData = GetAwsNetworkPerformanceData'
  { -- | A list of network performance data queries.
    GetAwsNetworkPerformanceData -> Maybe [DataQuery]
dataQueries :: Prelude.Maybe [DataQuery],
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    GetAwsNetworkPerformanceData -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ending time for the performance data request. The end time must be
    -- formatted as @yyyy-mm-ddThh:mm:ss@. For example,
    -- @2022-06-12T12:00:00.000Z@.
    GetAwsNetworkPerformanceData -> Maybe ISO8601
endTime :: Prelude.Maybe Data.ISO8601,
    -- | The maximum number of results to return with a single call. To retrieve
    -- the remaining results, make another call with the returned @nextToken@
    -- value.
    GetAwsNetworkPerformanceData -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | The token for the next page of results.
    GetAwsNetworkPerformanceData -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The starting time for the performance data request. The starting time
    -- must be formatted as @yyyy-mm-ddThh:mm:ss@. For example,
    -- @2022-06-10T12:00:00.000Z@.
    GetAwsNetworkPerformanceData -> Maybe ISO8601
startTime :: Prelude.Maybe Data.ISO8601
  }
  deriving (GetAwsNetworkPerformanceData
-> GetAwsNetworkPerformanceData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAwsNetworkPerformanceData
-> GetAwsNetworkPerformanceData -> Bool
$c/= :: GetAwsNetworkPerformanceData
-> GetAwsNetworkPerformanceData -> Bool
== :: GetAwsNetworkPerformanceData
-> GetAwsNetworkPerformanceData -> Bool
$c== :: GetAwsNetworkPerformanceData
-> GetAwsNetworkPerformanceData -> Bool
Prelude.Eq, ReadPrec [GetAwsNetworkPerformanceData]
ReadPrec GetAwsNetworkPerformanceData
Int -> ReadS GetAwsNetworkPerformanceData
ReadS [GetAwsNetworkPerformanceData]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAwsNetworkPerformanceData]
$creadListPrec :: ReadPrec [GetAwsNetworkPerformanceData]
readPrec :: ReadPrec GetAwsNetworkPerformanceData
$creadPrec :: ReadPrec GetAwsNetworkPerformanceData
readList :: ReadS [GetAwsNetworkPerformanceData]
$creadList :: ReadS [GetAwsNetworkPerformanceData]
readsPrec :: Int -> ReadS GetAwsNetworkPerformanceData
$creadsPrec :: Int -> ReadS GetAwsNetworkPerformanceData
Prelude.Read, Int -> GetAwsNetworkPerformanceData -> ShowS
[GetAwsNetworkPerformanceData] -> ShowS
GetAwsNetworkPerformanceData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAwsNetworkPerformanceData] -> ShowS
$cshowList :: [GetAwsNetworkPerformanceData] -> ShowS
show :: GetAwsNetworkPerformanceData -> String
$cshow :: GetAwsNetworkPerformanceData -> String
showsPrec :: Int -> GetAwsNetworkPerformanceData -> ShowS
$cshowsPrec :: Int -> GetAwsNetworkPerformanceData -> ShowS
Prelude.Show, forall x.
Rep GetAwsNetworkPerformanceData x -> GetAwsNetworkPerformanceData
forall x.
GetAwsNetworkPerformanceData -> Rep GetAwsNetworkPerformanceData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAwsNetworkPerformanceData x -> GetAwsNetworkPerformanceData
$cfrom :: forall x.
GetAwsNetworkPerformanceData -> Rep GetAwsNetworkPerformanceData x
Prelude.Generic)

-- |
-- Create a value of 'GetAwsNetworkPerformanceData' 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:
--
-- 'dataQueries', 'getAwsNetworkPerformanceData_dataQueries' - A list of network performance data queries.
--
-- 'dryRun', 'getAwsNetworkPerformanceData_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'endTime', 'getAwsNetworkPerformanceData_endTime' - The ending time for the performance data request. The end time must be
-- formatted as @yyyy-mm-ddThh:mm:ss@. For example,
-- @2022-06-12T12:00:00.000Z@.
--
-- 'maxResults', 'getAwsNetworkPerformanceData_maxResults' - The maximum number of results to return with a single call. To retrieve
-- the remaining results, make another call with the returned @nextToken@
-- value.
--
-- 'nextToken', 'getAwsNetworkPerformanceData_nextToken' - The token for the next page of results.
--
-- 'startTime', 'getAwsNetworkPerformanceData_startTime' - The starting time for the performance data request. The starting time
-- must be formatted as @yyyy-mm-ddThh:mm:ss@. For example,
-- @2022-06-10T12:00:00.000Z@.
newGetAwsNetworkPerformanceData ::
  GetAwsNetworkPerformanceData
newGetAwsNetworkPerformanceData :: GetAwsNetworkPerformanceData
newGetAwsNetworkPerformanceData =
  GetAwsNetworkPerformanceData'
    { $sel:dataQueries:GetAwsNetworkPerformanceData' :: Maybe [DataQuery]
dataQueries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:GetAwsNetworkPerformanceData' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:endTime:GetAwsNetworkPerformanceData' :: Maybe ISO8601
endTime = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetAwsNetworkPerformanceData' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetAwsNetworkPerformanceData' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startTime:GetAwsNetworkPerformanceData' :: Maybe ISO8601
startTime = forall a. Maybe a
Prelude.Nothing
    }

-- | A list of network performance data queries.
getAwsNetworkPerformanceData_dataQueries :: Lens.Lens' GetAwsNetworkPerformanceData (Prelude.Maybe [DataQuery])
getAwsNetworkPerformanceData_dataQueries :: Lens' GetAwsNetworkPerformanceData (Maybe [DataQuery])
getAwsNetworkPerformanceData_dataQueries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAwsNetworkPerformanceData' {Maybe [DataQuery]
dataQueries :: Maybe [DataQuery]
$sel:dataQueries:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe [DataQuery]
dataQueries} -> Maybe [DataQuery]
dataQueries) (\s :: GetAwsNetworkPerformanceData
s@GetAwsNetworkPerformanceData' {} Maybe [DataQuery]
a -> GetAwsNetworkPerformanceData
s {$sel:dataQueries:GetAwsNetworkPerformanceData' :: Maybe [DataQuery]
dataQueries = Maybe [DataQuery]
a} :: GetAwsNetworkPerformanceData) 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

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
getAwsNetworkPerformanceData_dryRun :: Lens.Lens' GetAwsNetworkPerformanceData (Prelude.Maybe Prelude.Bool)
getAwsNetworkPerformanceData_dryRun :: Lens' GetAwsNetworkPerformanceData (Maybe Bool)
getAwsNetworkPerformanceData_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAwsNetworkPerformanceData' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: GetAwsNetworkPerformanceData
s@GetAwsNetworkPerformanceData' {} Maybe Bool
a -> GetAwsNetworkPerformanceData
s {$sel:dryRun:GetAwsNetworkPerformanceData' :: Maybe Bool
dryRun = Maybe Bool
a} :: GetAwsNetworkPerformanceData)

-- | The ending time for the performance data request. The end time must be
-- formatted as @yyyy-mm-ddThh:mm:ss@. For example,
-- @2022-06-12T12:00:00.000Z@.
getAwsNetworkPerformanceData_endTime :: Lens.Lens' GetAwsNetworkPerformanceData (Prelude.Maybe Prelude.UTCTime)
getAwsNetworkPerformanceData_endTime :: Lens' GetAwsNetworkPerformanceData (Maybe UTCTime)
getAwsNetworkPerformanceData_endTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAwsNetworkPerformanceData' {Maybe ISO8601
endTime :: Maybe ISO8601
$sel:endTime:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe ISO8601
endTime} -> Maybe ISO8601
endTime) (\s :: GetAwsNetworkPerformanceData
s@GetAwsNetworkPerformanceData' {} Maybe ISO8601
a -> GetAwsNetworkPerformanceData
s {$sel:endTime:GetAwsNetworkPerformanceData' :: Maybe ISO8601
endTime = Maybe ISO8601
a} :: GetAwsNetworkPerformanceData) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The maximum number of results to return with a single call. To retrieve
-- the remaining results, make another call with the returned @nextToken@
-- value.
getAwsNetworkPerformanceData_maxResults :: Lens.Lens' GetAwsNetworkPerformanceData (Prelude.Maybe Prelude.Int)
getAwsNetworkPerformanceData_maxResults :: Lens' GetAwsNetworkPerformanceData (Maybe Int)
getAwsNetworkPerformanceData_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAwsNetworkPerformanceData' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: GetAwsNetworkPerformanceData
s@GetAwsNetworkPerformanceData' {} Maybe Int
a -> GetAwsNetworkPerformanceData
s {$sel:maxResults:GetAwsNetworkPerformanceData' :: Maybe Int
maxResults = Maybe Int
a} :: GetAwsNetworkPerformanceData)

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

-- | The starting time for the performance data request. The starting time
-- must be formatted as @yyyy-mm-ddThh:mm:ss@. For example,
-- @2022-06-10T12:00:00.000Z@.
getAwsNetworkPerformanceData_startTime :: Lens.Lens' GetAwsNetworkPerformanceData (Prelude.Maybe Prelude.UTCTime)
getAwsNetworkPerformanceData_startTime :: Lens' GetAwsNetworkPerformanceData (Maybe UTCTime)
getAwsNetworkPerformanceData_startTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAwsNetworkPerformanceData' {Maybe ISO8601
startTime :: Maybe ISO8601
$sel:startTime:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe ISO8601
startTime} -> Maybe ISO8601
startTime) (\s :: GetAwsNetworkPerformanceData
s@GetAwsNetworkPerformanceData' {} Maybe ISO8601
a -> GetAwsNetworkPerformanceData
s {$sel:startTime:GetAwsNetworkPerformanceData' :: Maybe ISO8601
startTime = Maybe ISO8601
a} :: GetAwsNetworkPerformanceData) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSPager GetAwsNetworkPerformanceData where
  page :: GetAwsNetworkPerformanceData
-> AWSResponse GetAwsNetworkPerformanceData
-> Maybe GetAwsNetworkPerformanceData
page GetAwsNetworkPerformanceData
rq AWSResponse GetAwsNetworkPerformanceData
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetAwsNetworkPerformanceData
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetAwsNetworkPerformanceDataResponse (Maybe Text)
getAwsNetworkPerformanceDataResponse_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 GetAwsNetworkPerformanceData
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetAwsNetworkPerformanceDataResponse (Maybe [DataResponse])
getAwsNetworkPerformanceDataResponse_dataResponses
            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.$ GetAwsNetworkPerformanceData
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetAwsNetworkPerformanceData (Maybe Text)
getAwsNetworkPerformanceData_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetAwsNetworkPerformanceData
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetAwsNetworkPerformanceDataResponse (Maybe Text)
getAwsNetworkPerformanceDataResponse_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 GetAwsNetworkPerformanceData where
  type
    AWSResponse GetAwsNetworkPerformanceData =
      GetAwsNetworkPerformanceDataResponse
  request :: (Service -> Service)
-> GetAwsNetworkPerformanceData
-> Request GetAwsNetworkPerformanceData
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetAwsNetworkPerformanceData
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetAwsNetworkPerformanceData)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [DataResponse]
-> Maybe Text -> Int -> GetAwsNetworkPerformanceDataResponse
GetAwsNetworkPerformanceDataResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"dataResponseSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"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
    GetAwsNetworkPerformanceData
  where
  hashWithSalt :: Int -> GetAwsNetworkPerformanceData -> Int
hashWithSalt Int
_salt GetAwsNetworkPerformanceData' {Maybe Bool
Maybe Int
Maybe [DataQuery]
Maybe Text
Maybe ISO8601
startTime :: Maybe ISO8601
nextToken :: Maybe Text
maxResults :: Maybe Int
endTime :: Maybe ISO8601
dryRun :: Maybe Bool
dataQueries :: Maybe [DataQuery]
$sel:startTime:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe ISO8601
$sel:nextToken:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Text
$sel:maxResults:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Int
$sel:endTime:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe ISO8601
$sel:dryRun:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Bool
$sel:dataQueries:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe [DataQuery]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DataQuery]
dataQueries
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
endTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
startTime

instance Prelude.NFData GetAwsNetworkPerformanceData where
  rnf :: GetAwsNetworkPerformanceData -> ()
rnf GetAwsNetworkPerformanceData' {Maybe Bool
Maybe Int
Maybe [DataQuery]
Maybe Text
Maybe ISO8601
startTime :: Maybe ISO8601
nextToken :: Maybe Text
maxResults :: Maybe Int
endTime :: Maybe ISO8601
dryRun :: Maybe Bool
dataQueries :: Maybe [DataQuery]
$sel:startTime:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe ISO8601
$sel:nextToken:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Text
$sel:maxResults:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Int
$sel:endTime:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe ISO8601
$sel:dryRun:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Bool
$sel:dataQueries:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe [DataQuery]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DataQuery]
dataQueries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
endTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
startTime

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

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

instance Data.ToQuery GetAwsNetworkPerformanceData where
  toQuery :: GetAwsNetworkPerformanceData -> QueryString
toQuery GetAwsNetworkPerformanceData' {Maybe Bool
Maybe Int
Maybe [DataQuery]
Maybe Text
Maybe ISO8601
startTime :: Maybe ISO8601
nextToken :: Maybe Text
maxResults :: Maybe Int
endTime :: Maybe ISO8601
dryRun :: Maybe Bool
dataQueries :: Maybe [DataQuery]
$sel:startTime:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe ISO8601
$sel:nextToken:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Text
$sel:maxResults:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Int
$sel:endTime:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe ISO8601
$sel:dryRun:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe Bool
$sel:dataQueries:GetAwsNetworkPerformanceData' :: GetAwsNetworkPerformanceData -> Maybe [DataQuery]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"GetAwsNetworkPerformanceData" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"DataQuery"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [DataQuery]
dataQueries
          ),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"EndTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
endTime,
        ByteString
"MaxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxResults,
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"StartTime" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe ISO8601
startTime
      ]

-- | /See:/ 'newGetAwsNetworkPerformanceDataResponse' smart constructor.
data GetAwsNetworkPerformanceDataResponse = GetAwsNetworkPerformanceDataResponse'
  { -- | The list of data responses.
    GetAwsNetworkPerformanceDataResponse -> Maybe [DataResponse]
dataResponses :: Prelude.Maybe [DataResponse],
    -- | The token to use to retrieve the next page of results. This value is
    -- @null@ when there are no more results to return.
    GetAwsNetworkPerformanceDataResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetAwsNetworkPerformanceDataResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetAwsNetworkPerformanceDataResponse
-> GetAwsNetworkPerformanceDataResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAwsNetworkPerformanceDataResponse
-> GetAwsNetworkPerformanceDataResponse -> Bool
$c/= :: GetAwsNetworkPerformanceDataResponse
-> GetAwsNetworkPerformanceDataResponse -> Bool
== :: GetAwsNetworkPerformanceDataResponse
-> GetAwsNetworkPerformanceDataResponse -> Bool
$c== :: GetAwsNetworkPerformanceDataResponse
-> GetAwsNetworkPerformanceDataResponse -> Bool
Prelude.Eq, ReadPrec [GetAwsNetworkPerformanceDataResponse]
ReadPrec GetAwsNetworkPerformanceDataResponse
Int -> ReadS GetAwsNetworkPerformanceDataResponse
ReadS [GetAwsNetworkPerformanceDataResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAwsNetworkPerformanceDataResponse]
$creadListPrec :: ReadPrec [GetAwsNetworkPerformanceDataResponse]
readPrec :: ReadPrec GetAwsNetworkPerformanceDataResponse
$creadPrec :: ReadPrec GetAwsNetworkPerformanceDataResponse
readList :: ReadS [GetAwsNetworkPerformanceDataResponse]
$creadList :: ReadS [GetAwsNetworkPerformanceDataResponse]
readsPrec :: Int -> ReadS GetAwsNetworkPerformanceDataResponse
$creadsPrec :: Int -> ReadS GetAwsNetworkPerformanceDataResponse
Prelude.Read, Int -> GetAwsNetworkPerformanceDataResponse -> ShowS
[GetAwsNetworkPerformanceDataResponse] -> ShowS
GetAwsNetworkPerformanceDataResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAwsNetworkPerformanceDataResponse] -> ShowS
$cshowList :: [GetAwsNetworkPerformanceDataResponse] -> ShowS
show :: GetAwsNetworkPerformanceDataResponse -> String
$cshow :: GetAwsNetworkPerformanceDataResponse -> String
showsPrec :: Int -> GetAwsNetworkPerformanceDataResponse -> ShowS
$cshowsPrec :: Int -> GetAwsNetworkPerformanceDataResponse -> ShowS
Prelude.Show, forall x.
Rep GetAwsNetworkPerformanceDataResponse x
-> GetAwsNetworkPerformanceDataResponse
forall x.
GetAwsNetworkPerformanceDataResponse
-> Rep GetAwsNetworkPerformanceDataResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAwsNetworkPerformanceDataResponse x
-> GetAwsNetworkPerformanceDataResponse
$cfrom :: forall x.
GetAwsNetworkPerformanceDataResponse
-> Rep GetAwsNetworkPerformanceDataResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAwsNetworkPerformanceDataResponse' 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:
--
-- 'dataResponses', 'getAwsNetworkPerformanceDataResponse_dataResponses' - The list of data responses.
--
-- 'nextToken', 'getAwsNetworkPerformanceDataResponse_nextToken' - The token to use to retrieve the next page of results. This value is
-- @null@ when there are no more results to return.
--
-- 'httpStatus', 'getAwsNetworkPerformanceDataResponse_httpStatus' - The response's http status code.
newGetAwsNetworkPerformanceDataResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAwsNetworkPerformanceDataResponse
newGetAwsNetworkPerformanceDataResponse :: Int -> GetAwsNetworkPerformanceDataResponse
newGetAwsNetworkPerformanceDataResponse Int
pHttpStatus_ =
  GetAwsNetworkPerformanceDataResponse'
    { $sel:dataResponses:GetAwsNetworkPerformanceDataResponse' :: Maybe [DataResponse]
dataResponses =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetAwsNetworkPerformanceDataResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAwsNetworkPerformanceDataResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of data responses.
getAwsNetworkPerformanceDataResponse_dataResponses :: Lens.Lens' GetAwsNetworkPerformanceDataResponse (Prelude.Maybe [DataResponse])
getAwsNetworkPerformanceDataResponse_dataResponses :: Lens' GetAwsNetworkPerformanceDataResponse (Maybe [DataResponse])
getAwsNetworkPerformanceDataResponse_dataResponses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAwsNetworkPerformanceDataResponse' {Maybe [DataResponse]
dataResponses :: Maybe [DataResponse]
$sel:dataResponses:GetAwsNetworkPerformanceDataResponse' :: GetAwsNetworkPerformanceDataResponse -> Maybe [DataResponse]
dataResponses} -> Maybe [DataResponse]
dataResponses) (\s :: GetAwsNetworkPerformanceDataResponse
s@GetAwsNetworkPerformanceDataResponse' {} Maybe [DataResponse]
a -> GetAwsNetworkPerformanceDataResponse
s {$sel:dataResponses:GetAwsNetworkPerformanceDataResponse' :: Maybe [DataResponse]
dataResponses = Maybe [DataResponse]
a} :: GetAwsNetworkPerformanceDataResponse) 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 token to use to retrieve the next page of results. This value is
-- @null@ when there are no more results to return.
getAwsNetworkPerformanceDataResponse_nextToken :: Lens.Lens' GetAwsNetworkPerformanceDataResponse (Prelude.Maybe Prelude.Text)
getAwsNetworkPerformanceDataResponse_nextToken :: Lens' GetAwsNetworkPerformanceDataResponse (Maybe Text)
getAwsNetworkPerformanceDataResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAwsNetworkPerformanceDataResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetAwsNetworkPerformanceDataResponse' :: GetAwsNetworkPerformanceDataResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetAwsNetworkPerformanceDataResponse
s@GetAwsNetworkPerformanceDataResponse' {} Maybe Text
a -> GetAwsNetworkPerformanceDataResponse
s {$sel:nextToken:GetAwsNetworkPerformanceDataResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetAwsNetworkPerformanceDataResponse)

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

instance
  Prelude.NFData
    GetAwsNetworkPerformanceDataResponse
  where
  rnf :: GetAwsNetworkPerformanceDataResponse -> ()
rnf GetAwsNetworkPerformanceDataResponse' {Int
Maybe [DataResponse]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
dataResponses :: Maybe [DataResponse]
$sel:httpStatus:GetAwsNetworkPerformanceDataResponse' :: GetAwsNetworkPerformanceDataResponse -> Int
$sel:nextToken:GetAwsNetworkPerformanceDataResponse' :: GetAwsNetworkPerformanceDataResponse -> Maybe Text
$sel:dataResponses:GetAwsNetworkPerformanceDataResponse' :: GetAwsNetworkPerformanceDataResponse -> Maybe [DataResponse]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DataResponse]
dataResponses
      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