{-# 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.Discovery.DescribeAgents
-- 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 agents or connectors as specified by ID or other filters. All
-- agents\/connectors associated with your user account can be listed if
-- you call @DescribeAgents@ as is without passing any parameters.
--
-- This operation returns paginated results.
module Amazonka.Discovery.DescribeAgents
  ( -- * Creating a Request
    DescribeAgents (..),
    newDescribeAgents,

    -- * Request Lenses
    describeAgents_agentIds,
    describeAgents_filters,
    describeAgents_maxResults,
    describeAgents_nextToken,

    -- * Destructuring the Response
    DescribeAgentsResponse (..),
    newDescribeAgentsResponse,

    -- * Response Lenses
    describeAgentsResponse_agentsInfo,
    describeAgentsResponse_nextToken,
    describeAgentsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribeAgents' smart constructor.
data DescribeAgents = DescribeAgents'
  { -- | The agent or the Connector IDs for which you want information. If you
    -- specify no IDs, the system returns information about all
    -- agents\/Connectors associated with your Amazon Web Services user
    -- account.
    DescribeAgents -> Maybe [Text]
agentIds :: Prelude.Maybe [Prelude.Text],
    -- | You can filter the request using various logical operators and a
    -- /key/-/value/ format. For example:
    --
    -- @{\"key\": \"collectionStatus\", \"value\": \"STARTED\"}@
    DescribeAgents -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | The total number of agents\/Connectors to return in a single page of
    -- output. The maximum value is 100.
    DescribeAgents -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | Token to retrieve the next set of results. For example, if you
    -- previously specified 100 IDs for @DescribeAgentsRequest$agentIds@ but
    -- set @DescribeAgentsRequest$maxResults@ to 10, you received a set of 10
    -- results along with a token. Use that token in this query to get the next
    -- set of 10.
    DescribeAgents -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeAgents -> DescribeAgents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAgents -> DescribeAgents -> Bool
$c/= :: DescribeAgents -> DescribeAgents -> Bool
== :: DescribeAgents -> DescribeAgents -> Bool
$c== :: DescribeAgents -> DescribeAgents -> Bool
Prelude.Eq, ReadPrec [DescribeAgents]
ReadPrec DescribeAgents
Int -> ReadS DescribeAgents
ReadS [DescribeAgents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAgents]
$creadListPrec :: ReadPrec [DescribeAgents]
readPrec :: ReadPrec DescribeAgents
$creadPrec :: ReadPrec DescribeAgents
readList :: ReadS [DescribeAgents]
$creadList :: ReadS [DescribeAgents]
readsPrec :: Int -> ReadS DescribeAgents
$creadsPrec :: Int -> ReadS DescribeAgents
Prelude.Read, Int -> DescribeAgents -> ShowS
[DescribeAgents] -> ShowS
DescribeAgents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAgents] -> ShowS
$cshowList :: [DescribeAgents] -> ShowS
show :: DescribeAgents -> String
$cshow :: DescribeAgents -> String
showsPrec :: Int -> DescribeAgents -> ShowS
$cshowsPrec :: Int -> DescribeAgents -> ShowS
Prelude.Show, forall x. Rep DescribeAgents x -> DescribeAgents
forall x. DescribeAgents -> Rep DescribeAgents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAgents x -> DescribeAgents
$cfrom :: forall x. DescribeAgents -> Rep DescribeAgents x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAgents' 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:
--
-- 'agentIds', 'describeAgents_agentIds' - The agent or the Connector IDs for which you want information. If you
-- specify no IDs, the system returns information about all
-- agents\/Connectors associated with your Amazon Web Services user
-- account.
--
-- 'filters', 'describeAgents_filters' - You can filter the request using various logical operators and a
-- /key/-/value/ format. For example:
--
-- @{\"key\": \"collectionStatus\", \"value\": \"STARTED\"}@
--
-- 'maxResults', 'describeAgents_maxResults' - The total number of agents\/Connectors to return in a single page of
-- output. The maximum value is 100.
--
-- 'nextToken', 'describeAgents_nextToken' - Token to retrieve the next set of results. For example, if you
-- previously specified 100 IDs for @DescribeAgentsRequest$agentIds@ but
-- set @DescribeAgentsRequest$maxResults@ to 10, you received a set of 10
-- results along with a token. Use that token in this query to get the next
-- set of 10.
newDescribeAgents ::
  DescribeAgents
newDescribeAgents :: DescribeAgents
newDescribeAgents =
  DescribeAgents'
    { $sel:agentIds:DescribeAgents' :: Maybe [Text]
agentIds = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeAgents' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeAgents' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeAgents' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The agent or the Connector IDs for which you want information. If you
-- specify no IDs, the system returns information about all
-- agents\/Connectors associated with your Amazon Web Services user
-- account.
describeAgents_agentIds :: Lens.Lens' DescribeAgents (Prelude.Maybe [Prelude.Text])
describeAgents_agentIds :: Lens' DescribeAgents (Maybe [Text])
describeAgents_agentIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAgents' {Maybe [Text]
agentIds :: Maybe [Text]
$sel:agentIds:DescribeAgents' :: DescribeAgents -> Maybe [Text]
agentIds} -> Maybe [Text]
agentIds) (\s :: DescribeAgents
s@DescribeAgents' {} Maybe [Text]
a -> DescribeAgents
s {$sel:agentIds:DescribeAgents' :: Maybe [Text]
agentIds = Maybe [Text]
a} :: DescribeAgents) 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

-- | You can filter the request using various logical operators and a
-- /key/-/value/ format. For example:
--
-- @{\"key\": \"collectionStatus\", \"value\": \"STARTED\"}@
describeAgents_filters :: Lens.Lens' DescribeAgents (Prelude.Maybe [Filter])
describeAgents_filters :: Lens' DescribeAgents (Maybe [Filter])
describeAgents_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAgents' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeAgents' :: DescribeAgents -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeAgents
s@DescribeAgents' {} Maybe [Filter]
a -> DescribeAgents
s {$sel:filters:DescribeAgents' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeAgents) 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 total number of agents\/Connectors to return in a single page of
-- output. The maximum value is 100.
describeAgents_maxResults :: Lens.Lens' DescribeAgents (Prelude.Maybe Prelude.Int)
describeAgents_maxResults :: Lens' DescribeAgents (Maybe Int)
describeAgents_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAgents' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:DescribeAgents' :: DescribeAgents -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: DescribeAgents
s@DescribeAgents' {} Maybe Int
a -> DescribeAgents
s {$sel:maxResults:DescribeAgents' :: Maybe Int
maxResults = Maybe Int
a} :: DescribeAgents)

-- | Token to retrieve the next set of results. For example, if you
-- previously specified 100 IDs for @DescribeAgentsRequest$agentIds@ but
-- set @DescribeAgentsRequest$maxResults@ to 10, you received a set of 10
-- results along with a token. Use that token in this query to get the next
-- set of 10.
describeAgents_nextToken :: Lens.Lens' DescribeAgents (Prelude.Maybe Prelude.Text)
describeAgents_nextToken :: Lens' DescribeAgents (Maybe Text)
describeAgents_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAgents' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeAgents' :: DescribeAgents -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeAgents
s@DescribeAgents' {} Maybe Text
a -> DescribeAgents
s {$sel:nextToken:DescribeAgents' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeAgents)

instance Core.AWSPager DescribeAgents where
  page :: DescribeAgents
-> AWSResponse DescribeAgents -> Maybe DescribeAgents
page DescribeAgents
rq AWSResponse DescribeAgents
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeAgents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeAgentsResponse (Maybe Text)
describeAgentsResponse_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 DescribeAgents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeAgentsResponse (Maybe [AgentInfo])
describeAgentsResponse_agentsInfo
            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.$ DescribeAgents
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeAgents (Maybe Text)
describeAgents_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeAgents
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeAgentsResponse (Maybe Text)
describeAgentsResponse_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 DescribeAgents where
  type
    AWSResponse DescribeAgents =
      DescribeAgentsResponse
  request :: (Service -> Service) -> DescribeAgents -> Request DescribeAgents
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 DescribeAgents
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeAgents)))
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 [AgentInfo] -> Maybe Text -> Int -> DescribeAgentsResponse
DescribeAgentsResponse'
            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
"agentsInfo" 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 DescribeAgents where
  hashWithSalt :: Int -> DescribeAgents -> Int
hashWithSalt Int
_salt DescribeAgents' {Maybe Int
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
agentIds :: Maybe [Text]
$sel:nextToken:DescribeAgents' :: DescribeAgents -> Maybe Text
$sel:maxResults:DescribeAgents' :: DescribeAgents -> Maybe Int
$sel:filters:DescribeAgents' :: DescribeAgents -> Maybe [Filter]
$sel:agentIds:DescribeAgents' :: DescribeAgents -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
agentIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData DescribeAgents where
  rnf :: DescribeAgents -> ()
rnf DescribeAgents' {Maybe Int
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
agentIds :: Maybe [Text]
$sel:nextToken:DescribeAgents' :: DescribeAgents -> Maybe Text
$sel:maxResults:DescribeAgents' :: DescribeAgents -> Maybe Int
$sel:filters:DescribeAgents' :: DescribeAgents -> Maybe [Filter]
$sel:agentIds:DescribeAgents' :: DescribeAgents -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
agentIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters
      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

instance Data.ToHeaders DescribeAgents where
  toHeaders :: DescribeAgents -> 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
"AWSPoseidonService_V2015_11_01.DescribeAgents" ::
                          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 DescribeAgents where
  toJSON :: DescribeAgents -> Value
toJSON DescribeAgents' {Maybe Int
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
agentIds :: Maybe [Text]
$sel:nextToken:DescribeAgents' :: DescribeAgents -> Maybe Text
$sel:maxResults:DescribeAgents' :: DescribeAgents -> Maybe Int
$sel:filters:DescribeAgents' :: DescribeAgents -> Maybe [Filter]
$sel:agentIds:DescribeAgents' :: DescribeAgents -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"agentIds" 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]
agentIds,
            (Key
"filters" 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 [Filter]
filters,
            (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
maxResults,
            (Key
"nextToken" 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
nextToken
          ]
      )

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

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

-- | /See:/ 'newDescribeAgentsResponse' smart constructor.
data DescribeAgentsResponse = DescribeAgentsResponse'
  { -- | Lists agents or the Connector by ID or lists all agents\/Connectors
    -- associated with your user account if you did not specify an
    -- agent\/Connector ID. The output includes agent\/Connector IDs, IP
    -- addresses, media access control (MAC) addresses, agent\/Connector
    -- health, host name where the agent\/Connector resides, and the version
    -- number of each agent\/Connector.
    DescribeAgentsResponse -> Maybe [AgentInfo]
agentsInfo :: Prelude.Maybe [AgentInfo],
    -- | Token to retrieve the next set of results. For example, if you specified
    -- 100 IDs for @DescribeAgentsRequest$agentIds@ but set
    -- @DescribeAgentsRequest$maxResults@ to 10, you received a set of 10
    -- results along with this token. Use this token in the next query to
    -- retrieve the next set of 10.
    DescribeAgentsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeAgentsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeAgentsResponse -> DescribeAgentsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeAgentsResponse -> DescribeAgentsResponse -> Bool
$c/= :: DescribeAgentsResponse -> DescribeAgentsResponse -> Bool
== :: DescribeAgentsResponse -> DescribeAgentsResponse -> Bool
$c== :: DescribeAgentsResponse -> DescribeAgentsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeAgentsResponse]
ReadPrec DescribeAgentsResponse
Int -> ReadS DescribeAgentsResponse
ReadS [DescribeAgentsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeAgentsResponse]
$creadListPrec :: ReadPrec [DescribeAgentsResponse]
readPrec :: ReadPrec DescribeAgentsResponse
$creadPrec :: ReadPrec DescribeAgentsResponse
readList :: ReadS [DescribeAgentsResponse]
$creadList :: ReadS [DescribeAgentsResponse]
readsPrec :: Int -> ReadS DescribeAgentsResponse
$creadsPrec :: Int -> ReadS DescribeAgentsResponse
Prelude.Read, Int -> DescribeAgentsResponse -> ShowS
[DescribeAgentsResponse] -> ShowS
DescribeAgentsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeAgentsResponse] -> ShowS
$cshowList :: [DescribeAgentsResponse] -> ShowS
show :: DescribeAgentsResponse -> String
$cshow :: DescribeAgentsResponse -> String
showsPrec :: Int -> DescribeAgentsResponse -> ShowS
$cshowsPrec :: Int -> DescribeAgentsResponse -> ShowS
Prelude.Show, forall x. Rep DescribeAgentsResponse x -> DescribeAgentsResponse
forall x. DescribeAgentsResponse -> Rep DescribeAgentsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeAgentsResponse x -> DescribeAgentsResponse
$cfrom :: forall x. DescribeAgentsResponse -> Rep DescribeAgentsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeAgentsResponse' 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:
--
-- 'agentsInfo', 'describeAgentsResponse_agentsInfo' - Lists agents or the Connector by ID or lists all agents\/Connectors
-- associated with your user account if you did not specify an
-- agent\/Connector ID. The output includes agent\/Connector IDs, IP
-- addresses, media access control (MAC) addresses, agent\/Connector
-- health, host name where the agent\/Connector resides, and the version
-- number of each agent\/Connector.
--
-- 'nextToken', 'describeAgentsResponse_nextToken' - Token to retrieve the next set of results. For example, if you specified
-- 100 IDs for @DescribeAgentsRequest$agentIds@ but set
-- @DescribeAgentsRequest$maxResults@ to 10, you received a set of 10
-- results along with this token. Use this token in the next query to
-- retrieve the next set of 10.
--
-- 'httpStatus', 'describeAgentsResponse_httpStatus' - The response's http status code.
newDescribeAgentsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeAgentsResponse
newDescribeAgentsResponse :: Int -> DescribeAgentsResponse
newDescribeAgentsResponse Int
pHttpStatus_ =
  DescribeAgentsResponse'
    { $sel:agentsInfo:DescribeAgentsResponse' :: Maybe [AgentInfo]
agentsInfo =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeAgentsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeAgentsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Lists agents or the Connector by ID or lists all agents\/Connectors
-- associated with your user account if you did not specify an
-- agent\/Connector ID. The output includes agent\/Connector IDs, IP
-- addresses, media access control (MAC) addresses, agent\/Connector
-- health, host name where the agent\/Connector resides, and the version
-- number of each agent\/Connector.
describeAgentsResponse_agentsInfo :: Lens.Lens' DescribeAgentsResponse (Prelude.Maybe [AgentInfo])
describeAgentsResponse_agentsInfo :: Lens' DescribeAgentsResponse (Maybe [AgentInfo])
describeAgentsResponse_agentsInfo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAgentsResponse' {Maybe [AgentInfo]
agentsInfo :: Maybe [AgentInfo]
$sel:agentsInfo:DescribeAgentsResponse' :: DescribeAgentsResponse -> Maybe [AgentInfo]
agentsInfo} -> Maybe [AgentInfo]
agentsInfo) (\s :: DescribeAgentsResponse
s@DescribeAgentsResponse' {} Maybe [AgentInfo]
a -> DescribeAgentsResponse
s {$sel:agentsInfo:DescribeAgentsResponse' :: Maybe [AgentInfo]
agentsInfo = Maybe [AgentInfo]
a} :: DescribeAgentsResponse) 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

-- | Token to retrieve the next set of results. For example, if you specified
-- 100 IDs for @DescribeAgentsRequest$agentIds@ but set
-- @DescribeAgentsRequest$maxResults@ to 10, you received a set of 10
-- results along with this token. Use this token in the next query to
-- retrieve the next set of 10.
describeAgentsResponse_nextToken :: Lens.Lens' DescribeAgentsResponse (Prelude.Maybe Prelude.Text)
describeAgentsResponse_nextToken :: Lens' DescribeAgentsResponse (Maybe Text)
describeAgentsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeAgentsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeAgentsResponse' :: DescribeAgentsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeAgentsResponse
s@DescribeAgentsResponse' {} Maybe Text
a -> DescribeAgentsResponse
s {$sel:nextToken:DescribeAgentsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeAgentsResponse)

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

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