{-# 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.RolesAnywhere.ListTrustAnchors
-- 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 trust anchors in the authenticated account and Amazon Web
-- Services Region.
--
-- __Required permissions:__ @rolesanywhere:ListTrustAnchors@.
--
-- This operation returns paginated results.
module Amazonka.RolesAnywhere.ListTrustAnchors
  ( -- * Creating a Request
    ListTrustAnchors (..),
    newListTrustAnchors,

    -- * Request Lenses
    listTrustAnchors_nextToken,
    listTrustAnchors_pageSize,

    -- * Destructuring the Response
    ListTrustAnchorsResponse (..),
    newListTrustAnchorsResponse,

    -- * Response Lenses
    listTrustAnchorsResponse_nextToken,
    listTrustAnchorsResponse_trustAnchors,
    listTrustAnchorsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListTrustAnchors' smart constructor.
data ListTrustAnchors = ListTrustAnchors'
  { -- | A token that indicates where the output should continue from, if a
    -- previous operation did not show all results. To get the next results,
    -- call the operation again with this value.
    ListTrustAnchors -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The number of resources in the paginated list.
    ListTrustAnchors -> Maybe Int
pageSize :: Prelude.Maybe Prelude.Int
  }
  deriving (ListTrustAnchors -> ListTrustAnchors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTrustAnchors -> ListTrustAnchors -> Bool
$c/= :: ListTrustAnchors -> ListTrustAnchors -> Bool
== :: ListTrustAnchors -> ListTrustAnchors -> Bool
$c== :: ListTrustAnchors -> ListTrustAnchors -> Bool
Prelude.Eq, ReadPrec [ListTrustAnchors]
ReadPrec ListTrustAnchors
Int -> ReadS ListTrustAnchors
ReadS [ListTrustAnchors]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTrustAnchors]
$creadListPrec :: ReadPrec [ListTrustAnchors]
readPrec :: ReadPrec ListTrustAnchors
$creadPrec :: ReadPrec ListTrustAnchors
readList :: ReadS [ListTrustAnchors]
$creadList :: ReadS [ListTrustAnchors]
readsPrec :: Int -> ReadS ListTrustAnchors
$creadsPrec :: Int -> ReadS ListTrustAnchors
Prelude.Read, Int -> ListTrustAnchors -> ShowS
[ListTrustAnchors] -> ShowS
ListTrustAnchors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTrustAnchors] -> ShowS
$cshowList :: [ListTrustAnchors] -> ShowS
show :: ListTrustAnchors -> String
$cshow :: ListTrustAnchors -> String
showsPrec :: Int -> ListTrustAnchors -> ShowS
$cshowsPrec :: Int -> ListTrustAnchors -> ShowS
Prelude.Show, forall x. Rep ListTrustAnchors x -> ListTrustAnchors
forall x. ListTrustAnchors -> Rep ListTrustAnchors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListTrustAnchors x -> ListTrustAnchors
$cfrom :: forall x. ListTrustAnchors -> Rep ListTrustAnchors x
Prelude.Generic)

-- |
-- Create a value of 'ListTrustAnchors' 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:
--
-- 'nextToken', 'listTrustAnchors_nextToken' - A token that indicates where the output should continue from, if a
-- previous operation did not show all results. To get the next results,
-- call the operation again with this value.
--
-- 'pageSize', 'listTrustAnchors_pageSize' - The number of resources in the paginated list.
newListTrustAnchors ::
  ListTrustAnchors
newListTrustAnchors :: ListTrustAnchors
newListTrustAnchors =
  ListTrustAnchors'
    { $sel:nextToken:ListTrustAnchors' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:pageSize:ListTrustAnchors' :: Maybe Int
pageSize = forall a. Maybe a
Prelude.Nothing
    }

-- | A token that indicates where the output should continue from, if a
-- previous operation did not show all results. To get the next results,
-- call the operation again with this value.
listTrustAnchors_nextToken :: Lens.Lens' ListTrustAnchors (Prelude.Maybe Prelude.Text)
listTrustAnchors_nextToken :: Lens' ListTrustAnchors (Maybe Text)
listTrustAnchors_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTrustAnchors' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTrustAnchors' :: ListTrustAnchors -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTrustAnchors
s@ListTrustAnchors' {} Maybe Text
a -> ListTrustAnchors
s {$sel:nextToken:ListTrustAnchors' :: Maybe Text
nextToken = Maybe Text
a} :: ListTrustAnchors)

-- | The number of resources in the paginated list.
listTrustAnchors_pageSize :: Lens.Lens' ListTrustAnchors (Prelude.Maybe Prelude.Int)
listTrustAnchors_pageSize :: Lens' ListTrustAnchors (Maybe Int)
listTrustAnchors_pageSize = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTrustAnchors' {Maybe Int
pageSize :: Maybe Int
$sel:pageSize:ListTrustAnchors' :: ListTrustAnchors -> Maybe Int
pageSize} -> Maybe Int
pageSize) (\s :: ListTrustAnchors
s@ListTrustAnchors' {} Maybe Int
a -> ListTrustAnchors
s {$sel:pageSize:ListTrustAnchors' :: Maybe Int
pageSize = Maybe Int
a} :: ListTrustAnchors)

instance Core.AWSPager ListTrustAnchors where
  page :: ListTrustAnchors
-> AWSResponse ListTrustAnchors -> Maybe ListTrustAnchors
page ListTrustAnchors
rq AWSResponse ListTrustAnchors
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListTrustAnchors
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTrustAnchorsResponse (Maybe Text)
listTrustAnchorsResponse_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 ListTrustAnchors
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTrustAnchorsResponse (Maybe [TrustAnchorDetail])
listTrustAnchorsResponse_trustAnchors
            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.$ ListTrustAnchors
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListTrustAnchors (Maybe Text)
listTrustAnchors_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListTrustAnchors
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListTrustAnchorsResponse (Maybe Text)
listTrustAnchorsResponse_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 ListTrustAnchors where
  type
    AWSResponse ListTrustAnchors =
      ListTrustAnchorsResponse
  request :: (Service -> Service)
-> ListTrustAnchors -> Request ListTrustAnchors
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 ListTrustAnchors
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListTrustAnchors)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe [TrustAnchorDetail] -> Int -> ListTrustAnchorsResponse
ListTrustAnchorsResponse'
            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
"nextToken")
            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
"trustAnchors" 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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable ListTrustAnchors where
  hashWithSalt :: Int -> ListTrustAnchors -> Int
hashWithSalt Int
_salt ListTrustAnchors' {Maybe Int
Maybe Text
pageSize :: Maybe Int
nextToken :: Maybe Text
$sel:pageSize:ListTrustAnchors' :: ListTrustAnchors -> Maybe Int
$sel:nextToken:ListTrustAnchors' :: ListTrustAnchors -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
pageSize

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

instance Data.ToHeaders ListTrustAnchors where
  toHeaders :: ListTrustAnchors -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

instance Data.ToQuery ListTrustAnchors where
  toQuery :: ListTrustAnchors -> QueryString
toQuery ListTrustAnchors' {Maybe Int
Maybe Text
pageSize :: Maybe Int
nextToken :: Maybe Text
$sel:pageSize:ListTrustAnchors' :: ListTrustAnchors -> Maybe Int
$sel:nextToken:ListTrustAnchors' :: ListTrustAnchors -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"pageSize" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
pageSize
      ]

-- | /See:/ 'newListTrustAnchorsResponse' smart constructor.
data ListTrustAnchorsResponse = ListTrustAnchorsResponse'
  { -- | A token that indicates where the output should continue from, if a
    -- previous operation did not show all results. To get the next results,
    -- call the operation again with this value.
    ListTrustAnchorsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of trust anchors.
    ListTrustAnchorsResponse -> Maybe [TrustAnchorDetail]
trustAnchors :: Prelude.Maybe [TrustAnchorDetail],
    -- | The response's http status code.
    ListTrustAnchorsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListTrustAnchorsResponse -> ListTrustAnchorsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListTrustAnchorsResponse -> ListTrustAnchorsResponse -> Bool
$c/= :: ListTrustAnchorsResponse -> ListTrustAnchorsResponse -> Bool
== :: ListTrustAnchorsResponse -> ListTrustAnchorsResponse -> Bool
$c== :: ListTrustAnchorsResponse -> ListTrustAnchorsResponse -> Bool
Prelude.Eq, ReadPrec [ListTrustAnchorsResponse]
ReadPrec ListTrustAnchorsResponse
Int -> ReadS ListTrustAnchorsResponse
ReadS [ListTrustAnchorsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListTrustAnchorsResponse]
$creadListPrec :: ReadPrec [ListTrustAnchorsResponse]
readPrec :: ReadPrec ListTrustAnchorsResponse
$creadPrec :: ReadPrec ListTrustAnchorsResponse
readList :: ReadS [ListTrustAnchorsResponse]
$creadList :: ReadS [ListTrustAnchorsResponse]
readsPrec :: Int -> ReadS ListTrustAnchorsResponse
$creadsPrec :: Int -> ReadS ListTrustAnchorsResponse
Prelude.Read, Int -> ListTrustAnchorsResponse -> ShowS
[ListTrustAnchorsResponse] -> ShowS
ListTrustAnchorsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListTrustAnchorsResponse] -> ShowS
$cshowList :: [ListTrustAnchorsResponse] -> ShowS
show :: ListTrustAnchorsResponse -> String
$cshow :: ListTrustAnchorsResponse -> String
showsPrec :: Int -> ListTrustAnchorsResponse -> ShowS
$cshowsPrec :: Int -> ListTrustAnchorsResponse -> ShowS
Prelude.Show, forall x.
Rep ListTrustAnchorsResponse x -> ListTrustAnchorsResponse
forall x.
ListTrustAnchorsResponse -> Rep ListTrustAnchorsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListTrustAnchorsResponse x -> ListTrustAnchorsResponse
$cfrom :: forall x.
ListTrustAnchorsResponse -> Rep ListTrustAnchorsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListTrustAnchorsResponse' 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:
--
-- 'nextToken', 'listTrustAnchorsResponse_nextToken' - A token that indicates where the output should continue from, if a
-- previous operation did not show all results. To get the next results,
-- call the operation again with this value.
--
-- 'trustAnchors', 'listTrustAnchorsResponse_trustAnchors' - A list of trust anchors.
--
-- 'httpStatus', 'listTrustAnchorsResponse_httpStatus' - The response's http status code.
newListTrustAnchorsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListTrustAnchorsResponse
newListTrustAnchorsResponse :: Int -> ListTrustAnchorsResponse
newListTrustAnchorsResponse Int
pHttpStatus_ =
  ListTrustAnchorsResponse'
    { $sel:nextToken:ListTrustAnchorsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:trustAnchors:ListTrustAnchorsResponse' :: Maybe [TrustAnchorDetail]
trustAnchors = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListTrustAnchorsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A token that indicates where the output should continue from, if a
-- previous operation did not show all results. To get the next results,
-- call the operation again with this value.
listTrustAnchorsResponse_nextToken :: Lens.Lens' ListTrustAnchorsResponse (Prelude.Maybe Prelude.Text)
listTrustAnchorsResponse_nextToken :: Lens' ListTrustAnchorsResponse (Maybe Text)
listTrustAnchorsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTrustAnchorsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListTrustAnchorsResponse' :: ListTrustAnchorsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListTrustAnchorsResponse
s@ListTrustAnchorsResponse' {} Maybe Text
a -> ListTrustAnchorsResponse
s {$sel:nextToken:ListTrustAnchorsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListTrustAnchorsResponse)

-- | A list of trust anchors.
listTrustAnchorsResponse_trustAnchors :: Lens.Lens' ListTrustAnchorsResponse (Prelude.Maybe [TrustAnchorDetail])
listTrustAnchorsResponse_trustAnchors :: Lens' ListTrustAnchorsResponse (Maybe [TrustAnchorDetail])
listTrustAnchorsResponse_trustAnchors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTrustAnchorsResponse' {Maybe [TrustAnchorDetail]
trustAnchors :: Maybe [TrustAnchorDetail]
$sel:trustAnchors:ListTrustAnchorsResponse' :: ListTrustAnchorsResponse -> Maybe [TrustAnchorDetail]
trustAnchors} -> Maybe [TrustAnchorDetail]
trustAnchors) (\s :: ListTrustAnchorsResponse
s@ListTrustAnchorsResponse' {} Maybe [TrustAnchorDetail]
a -> ListTrustAnchorsResponse
s {$sel:trustAnchors:ListTrustAnchorsResponse' :: Maybe [TrustAnchorDetail]
trustAnchors = Maybe [TrustAnchorDetail]
a} :: ListTrustAnchorsResponse) 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 response's http status code.
listTrustAnchorsResponse_httpStatus :: Lens.Lens' ListTrustAnchorsResponse Prelude.Int
listTrustAnchorsResponse_httpStatus :: Lens' ListTrustAnchorsResponse Int
listTrustAnchorsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListTrustAnchorsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListTrustAnchorsResponse' :: ListTrustAnchorsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListTrustAnchorsResponse
s@ListTrustAnchorsResponse' {} Int
a -> ListTrustAnchorsResponse
s {$sel:httpStatus:ListTrustAnchorsResponse' :: Int
httpStatus = Int
a} :: ListTrustAnchorsResponse)

instance Prelude.NFData ListTrustAnchorsResponse where
  rnf :: ListTrustAnchorsResponse -> ()
rnf ListTrustAnchorsResponse' {Int
Maybe [TrustAnchorDetail]
Maybe Text
httpStatus :: Int
trustAnchors :: Maybe [TrustAnchorDetail]
nextToken :: Maybe Text
$sel:httpStatus:ListTrustAnchorsResponse' :: ListTrustAnchorsResponse -> Int
$sel:trustAnchors:ListTrustAnchorsResponse' :: ListTrustAnchorsResponse -> Maybe [TrustAnchorDetail]
$sel:nextToken:ListTrustAnchorsResponse' :: ListTrustAnchorsResponse -> Maybe Text
..} =
    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 [TrustAnchorDetail]
trustAnchors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus