{-# 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.DataSync.ListAgents
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns a list of agents owned by an Amazon Web Services account in the
-- Amazon Web Services Region specified in the request. The returned list
-- is ordered by agent Amazon Resource Name (ARN).
--
-- By default, this operation returns a maximum of 100 agents. This
-- operation supports pagination that enables you to optionally reduce the
-- number of agents returned in a response.
--
-- If you have more agents than are returned in a response (that is, the
-- response returns only a truncated list of your agents), the response
-- contains a marker that you can specify in your next request to fetch the
-- next page of agents.
--
-- This operation returns paginated results.
module Amazonka.DataSync.ListAgents
  ( -- * Creating a Request
    ListAgents (..),
    newListAgents,

    -- * Request Lenses
    listAgents_maxResults,
    listAgents_nextToken,

    -- * Destructuring the Response
    ListAgentsResponse (..),
    newListAgentsResponse,

    -- * Response Lenses
    listAgentsResponse_agents,
    listAgentsResponse_nextToken,
    listAgentsResponse_httpStatus,
  )
where

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

-- | ListAgentsRequest
--
-- /See:/ 'newListAgents' smart constructor.
data ListAgents = ListAgents'
  { -- | The maximum number of agents to list.
    ListAgents -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | An opaque string that indicates the position at which to begin the next
    -- list of agents.
    ListAgents -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (ListAgents -> ListAgents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAgents -> ListAgents -> Bool
$c/= :: ListAgents -> ListAgents -> Bool
== :: ListAgents -> ListAgents -> Bool
$c== :: ListAgents -> ListAgents -> Bool
Prelude.Eq, ReadPrec [ListAgents]
ReadPrec ListAgents
Int -> ReadS ListAgents
ReadS [ListAgents]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAgents]
$creadListPrec :: ReadPrec [ListAgents]
readPrec :: ReadPrec ListAgents
$creadPrec :: ReadPrec ListAgents
readList :: ReadS [ListAgents]
$creadList :: ReadS [ListAgents]
readsPrec :: Int -> ReadS ListAgents
$creadsPrec :: Int -> ReadS ListAgents
Prelude.Read, Int -> ListAgents -> ShowS
[ListAgents] -> ShowS
ListAgents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAgents] -> ShowS
$cshowList :: [ListAgents] -> ShowS
show :: ListAgents -> String
$cshow :: ListAgents -> String
showsPrec :: Int -> ListAgents -> ShowS
$cshowsPrec :: Int -> ListAgents -> ShowS
Prelude.Show, forall x. Rep ListAgents x -> ListAgents
forall x. ListAgents -> Rep ListAgents x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAgents x -> ListAgents
$cfrom :: forall x. ListAgents -> Rep ListAgents x
Prelude.Generic)

-- |
-- Create a value of 'ListAgents' 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:
--
-- 'maxResults', 'listAgents_maxResults' - The maximum number of agents to list.
--
-- 'nextToken', 'listAgents_nextToken' - An opaque string that indicates the position at which to begin the next
-- list of agents.
newListAgents ::
  ListAgents
newListAgents :: ListAgents
newListAgents =
  ListAgents'
    { $sel:maxResults:ListAgents' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAgents' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of agents to list.
listAgents_maxResults :: Lens.Lens' ListAgents (Prelude.Maybe Prelude.Natural)
listAgents_maxResults :: Lens' ListAgents (Maybe Natural)
listAgents_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAgents' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListAgents' :: ListAgents -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListAgents
s@ListAgents' {} Maybe Natural
a -> ListAgents
s {$sel:maxResults:ListAgents' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListAgents)

-- | An opaque string that indicates the position at which to begin the next
-- list of agents.
listAgents_nextToken :: Lens.Lens' ListAgents (Prelude.Maybe Prelude.Text)
listAgents_nextToken :: Lens' ListAgents (Maybe Text)
listAgents_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAgents' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAgents' :: ListAgents -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAgents
s@ListAgents' {} Maybe Text
a -> ListAgents
s {$sel:nextToken:ListAgents' :: Maybe Text
nextToken = Maybe Text
a} :: ListAgents)

instance Core.AWSPager ListAgents where
  page :: ListAgents -> AWSResponse ListAgents -> Maybe ListAgents
page ListAgents
rq AWSResponse ListAgents
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAgents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAgentsResponse (Maybe Text)
listAgentsResponse_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 ListAgents
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAgentsResponse (Maybe [AgentListEntry])
listAgentsResponse_agents
            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.$ ListAgents
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListAgents (Maybe Text)
listAgents_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListAgents
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAgentsResponse (Maybe Text)
listAgentsResponse_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 ListAgents where
  type AWSResponse ListAgents = ListAgentsResponse
  request :: (Service -> Service) -> ListAgents -> Request ListAgents
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 ListAgents
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListAgents)))
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 [AgentListEntry] -> Maybe Text -> Int -> ListAgentsResponse
ListAgentsResponse'
            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
"Agents" 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 ListAgents where
  hashWithSalt :: Int -> ListAgents -> Int
hashWithSalt Int
_salt ListAgents' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListAgents' :: ListAgents -> Maybe Text
$sel:maxResults:ListAgents' :: ListAgents -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData ListAgents where
  rnf :: ListAgents -> ()
rnf ListAgents' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListAgents' :: ListAgents -> Maybe Text
$sel:maxResults:ListAgents' :: ListAgents -> Maybe Natural
..} =
    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

instance Data.ToHeaders ListAgents where
  toHeaders :: ListAgents -> 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
"FmrsService.ListAgents" :: 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 ListAgents where
  toJSON :: ListAgents -> Value
toJSON ListAgents' {Maybe Natural
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:nextToken:ListAgents' :: ListAgents -> Maybe Text
$sel:maxResults:ListAgents' :: ListAgents -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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
"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 ListAgents where
  toPath :: ListAgents -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | ListAgentsResponse
--
-- /See:/ 'newListAgentsResponse' smart constructor.
data ListAgentsResponse = ListAgentsResponse'
  { -- | A list of agents in your account.
    ListAgentsResponse -> Maybe [AgentListEntry]
agents :: Prelude.Maybe [AgentListEntry],
    -- | An opaque string that indicates the position at which to begin returning
    -- the next list of agents.
    ListAgentsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListAgentsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListAgentsResponse -> ListAgentsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAgentsResponse -> ListAgentsResponse -> Bool
$c/= :: ListAgentsResponse -> ListAgentsResponse -> Bool
== :: ListAgentsResponse -> ListAgentsResponse -> Bool
$c== :: ListAgentsResponse -> ListAgentsResponse -> Bool
Prelude.Eq, ReadPrec [ListAgentsResponse]
ReadPrec ListAgentsResponse
Int -> ReadS ListAgentsResponse
ReadS [ListAgentsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAgentsResponse]
$creadListPrec :: ReadPrec [ListAgentsResponse]
readPrec :: ReadPrec ListAgentsResponse
$creadPrec :: ReadPrec ListAgentsResponse
readList :: ReadS [ListAgentsResponse]
$creadList :: ReadS [ListAgentsResponse]
readsPrec :: Int -> ReadS ListAgentsResponse
$creadsPrec :: Int -> ReadS ListAgentsResponse
Prelude.Read, Int -> ListAgentsResponse -> ShowS
[ListAgentsResponse] -> ShowS
ListAgentsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAgentsResponse] -> ShowS
$cshowList :: [ListAgentsResponse] -> ShowS
show :: ListAgentsResponse -> String
$cshow :: ListAgentsResponse -> String
showsPrec :: Int -> ListAgentsResponse -> ShowS
$cshowsPrec :: Int -> ListAgentsResponse -> ShowS
Prelude.Show, forall x. Rep ListAgentsResponse x -> ListAgentsResponse
forall x. ListAgentsResponse -> Rep ListAgentsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListAgentsResponse x -> ListAgentsResponse
$cfrom :: forall x. ListAgentsResponse -> Rep ListAgentsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAgentsResponse' 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:
--
-- 'agents', 'listAgentsResponse_agents' - A list of agents in your account.
--
-- 'nextToken', 'listAgentsResponse_nextToken' - An opaque string that indicates the position at which to begin returning
-- the next list of agents.
--
-- 'httpStatus', 'listAgentsResponse_httpStatus' - The response's http status code.
newListAgentsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAgentsResponse
newListAgentsResponse :: Int -> ListAgentsResponse
newListAgentsResponse Int
pHttpStatus_ =
  ListAgentsResponse'
    { $sel:agents:ListAgentsResponse' :: Maybe [AgentListEntry]
agents = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListAgentsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListAgentsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of agents in your account.
listAgentsResponse_agents :: Lens.Lens' ListAgentsResponse (Prelude.Maybe [AgentListEntry])
listAgentsResponse_agents :: Lens' ListAgentsResponse (Maybe [AgentListEntry])
listAgentsResponse_agents = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAgentsResponse' {Maybe [AgentListEntry]
agents :: Maybe [AgentListEntry]
$sel:agents:ListAgentsResponse' :: ListAgentsResponse -> Maybe [AgentListEntry]
agents} -> Maybe [AgentListEntry]
agents) (\s :: ListAgentsResponse
s@ListAgentsResponse' {} Maybe [AgentListEntry]
a -> ListAgentsResponse
s {$sel:agents:ListAgentsResponse' :: Maybe [AgentListEntry]
agents = Maybe [AgentListEntry]
a} :: ListAgentsResponse) 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

-- | An opaque string that indicates the position at which to begin returning
-- the next list of agents.
listAgentsResponse_nextToken :: Lens.Lens' ListAgentsResponse (Prelude.Maybe Prelude.Text)
listAgentsResponse_nextToken :: Lens' ListAgentsResponse (Maybe Text)
listAgentsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAgentsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListAgentsResponse' :: ListAgentsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListAgentsResponse
s@ListAgentsResponse' {} Maybe Text
a -> ListAgentsResponse
s {$sel:nextToken:ListAgentsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListAgentsResponse)

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

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