{-# 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.WorkMail.ListResourceDelegates
-- 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 delegates associated with a resource. Users and groups can be
-- resource delegates and answer requests on behalf of the resource.
--
-- This operation returns paginated results.
module Amazonka.WorkMail.ListResourceDelegates
  ( -- * Creating a Request
    ListResourceDelegates (..),
    newListResourceDelegates,

    -- * Request Lenses
    listResourceDelegates_maxResults,
    listResourceDelegates_nextToken,
    listResourceDelegates_organizationId,
    listResourceDelegates_resourceId,

    -- * Destructuring the Response
    ListResourceDelegatesResponse (..),
    newListResourceDelegatesResponse,

    -- * Response Lenses
    listResourceDelegatesResponse_delegates,
    listResourceDelegatesResponse_nextToken,
    listResourceDelegatesResponse_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.WorkMail.Types

-- | /See:/ 'newListResourceDelegates' smart constructor.
data ListResourceDelegates = ListResourceDelegates'
  { -- | The number of maximum results in a page.
    ListResourceDelegates -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token used to paginate through the delegates associated with a
    -- resource.
    ListResourceDelegates -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The identifier for the organization that contains the resource for which
    -- delegates are listed.
    ListResourceDelegates -> Text
organizationId :: Prelude.Text,
    -- | The identifier for the resource whose delegates are listed.
    ListResourceDelegates -> Text
resourceId :: Prelude.Text
  }
  deriving (ListResourceDelegates -> ListResourceDelegates -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListResourceDelegates -> ListResourceDelegates -> Bool
$c/= :: ListResourceDelegates -> ListResourceDelegates -> Bool
== :: ListResourceDelegates -> ListResourceDelegates -> Bool
$c== :: ListResourceDelegates -> ListResourceDelegates -> Bool
Prelude.Eq, ReadPrec [ListResourceDelegates]
ReadPrec ListResourceDelegates
Int -> ReadS ListResourceDelegates
ReadS [ListResourceDelegates]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListResourceDelegates]
$creadListPrec :: ReadPrec [ListResourceDelegates]
readPrec :: ReadPrec ListResourceDelegates
$creadPrec :: ReadPrec ListResourceDelegates
readList :: ReadS [ListResourceDelegates]
$creadList :: ReadS [ListResourceDelegates]
readsPrec :: Int -> ReadS ListResourceDelegates
$creadsPrec :: Int -> ReadS ListResourceDelegates
Prelude.Read, Int -> ListResourceDelegates -> ShowS
[ListResourceDelegates] -> ShowS
ListResourceDelegates -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListResourceDelegates] -> ShowS
$cshowList :: [ListResourceDelegates] -> ShowS
show :: ListResourceDelegates -> String
$cshow :: ListResourceDelegates -> String
showsPrec :: Int -> ListResourceDelegates -> ShowS
$cshowsPrec :: Int -> ListResourceDelegates -> ShowS
Prelude.Show, forall x. Rep ListResourceDelegates x -> ListResourceDelegates
forall x. ListResourceDelegates -> Rep ListResourceDelegates x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListResourceDelegates x -> ListResourceDelegates
$cfrom :: forall x. ListResourceDelegates -> Rep ListResourceDelegates x
Prelude.Generic)

-- |
-- Create a value of 'ListResourceDelegates' 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', 'listResourceDelegates_maxResults' - The number of maximum results in a page.
--
-- 'nextToken', 'listResourceDelegates_nextToken' - The token used to paginate through the delegates associated with a
-- resource.
--
-- 'organizationId', 'listResourceDelegates_organizationId' - The identifier for the organization that contains the resource for which
-- delegates are listed.
--
-- 'resourceId', 'listResourceDelegates_resourceId' - The identifier for the resource whose delegates are listed.
newListResourceDelegates ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'resourceId'
  Prelude.Text ->
  ListResourceDelegates
newListResourceDelegates :: Text -> Text -> ListResourceDelegates
newListResourceDelegates
  Text
pOrganizationId_
  Text
pResourceId_ =
    ListResourceDelegates'
      { $sel:maxResults:ListResourceDelegates' :: Maybe Natural
maxResults =
          forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListResourceDelegates' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:organizationId:ListResourceDelegates' :: Text
organizationId = Text
pOrganizationId_,
        $sel:resourceId:ListResourceDelegates' :: Text
resourceId = Text
pResourceId_
      }

-- | The number of maximum results in a page.
listResourceDelegates_maxResults :: Lens.Lens' ListResourceDelegates (Prelude.Maybe Prelude.Natural)
listResourceDelegates_maxResults :: Lens' ListResourceDelegates (Maybe Natural)
listResourceDelegates_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListResourceDelegates' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListResourceDelegates' :: ListResourceDelegates -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListResourceDelegates
s@ListResourceDelegates' {} Maybe Natural
a -> ListResourceDelegates
s {$sel:maxResults:ListResourceDelegates' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListResourceDelegates)

-- | The token used to paginate through the delegates associated with a
-- resource.
listResourceDelegates_nextToken :: Lens.Lens' ListResourceDelegates (Prelude.Maybe Prelude.Text)
listResourceDelegates_nextToken :: Lens' ListResourceDelegates (Maybe Text)
listResourceDelegates_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListResourceDelegates' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListResourceDelegates' :: ListResourceDelegates -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListResourceDelegates
s@ListResourceDelegates' {} Maybe Text
a -> ListResourceDelegates
s {$sel:nextToken:ListResourceDelegates' :: Maybe Text
nextToken = Maybe Text
a} :: ListResourceDelegates)

-- | The identifier for the organization that contains the resource for which
-- delegates are listed.
listResourceDelegates_organizationId :: Lens.Lens' ListResourceDelegates Prelude.Text
listResourceDelegates_organizationId :: Lens' ListResourceDelegates Text
listResourceDelegates_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListResourceDelegates' {Text
organizationId :: Text
$sel:organizationId:ListResourceDelegates' :: ListResourceDelegates -> Text
organizationId} -> Text
organizationId) (\s :: ListResourceDelegates
s@ListResourceDelegates' {} Text
a -> ListResourceDelegates
s {$sel:organizationId:ListResourceDelegates' :: Text
organizationId = Text
a} :: ListResourceDelegates)

-- | The identifier for the resource whose delegates are listed.
listResourceDelegates_resourceId :: Lens.Lens' ListResourceDelegates Prelude.Text
listResourceDelegates_resourceId :: Lens' ListResourceDelegates Text
listResourceDelegates_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListResourceDelegates' {Text
resourceId :: Text
$sel:resourceId:ListResourceDelegates' :: ListResourceDelegates -> Text
resourceId} -> Text
resourceId) (\s :: ListResourceDelegates
s@ListResourceDelegates' {} Text
a -> ListResourceDelegates
s {$sel:resourceId:ListResourceDelegates' :: Text
resourceId = Text
a} :: ListResourceDelegates)

instance Core.AWSPager ListResourceDelegates where
  page :: ListResourceDelegates
-> AWSResponse ListResourceDelegates -> Maybe ListResourceDelegates
page ListResourceDelegates
rq AWSResponse ListResourceDelegates
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListResourceDelegates
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListResourceDelegatesResponse (Maybe Text)
listResourceDelegatesResponse_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 ListResourceDelegates
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListResourceDelegatesResponse (Maybe [Delegate])
listResourceDelegatesResponse_delegates
            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.$ ListResourceDelegates
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListResourceDelegates (Maybe Text)
listResourceDelegates_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListResourceDelegates
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListResourceDelegatesResponse (Maybe Text)
listResourceDelegatesResponse_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 ListResourceDelegates where
  type
    AWSResponse ListResourceDelegates =
      ListResourceDelegatesResponse
  request :: (Service -> Service)
-> ListResourceDelegates -> Request ListResourceDelegates
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 ListResourceDelegates
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListResourceDelegates)))
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 [Delegate]
-> Maybe Text -> Int -> ListResourceDelegatesResponse
ListResourceDelegatesResponse'
            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
"Delegates" 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 ListResourceDelegates where
  hashWithSalt :: Int -> ListResourceDelegates -> Int
hashWithSalt Int
_salt ListResourceDelegates' {Maybe Natural
Maybe Text
Text
resourceId :: Text
organizationId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceId:ListResourceDelegates' :: ListResourceDelegates -> Text
$sel:organizationId:ListResourceDelegates' :: ListResourceDelegates -> Text
$sel:nextToken:ListResourceDelegates' :: ListResourceDelegates -> Maybe Text
$sel:maxResults:ListResourceDelegates' :: ListResourceDelegates -> 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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
organizationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId

instance Prelude.NFData ListResourceDelegates where
  rnf :: ListResourceDelegates -> ()
rnf ListResourceDelegates' {Maybe Natural
Maybe Text
Text
resourceId :: Text
organizationId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceId:ListResourceDelegates' :: ListResourceDelegates -> Text
$sel:organizationId:ListResourceDelegates' :: ListResourceDelegates -> Text
$sel:nextToken:ListResourceDelegates' :: ListResourceDelegates -> Maybe Text
$sel:maxResults:ListResourceDelegates' :: ListResourceDelegates -> 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
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
organizationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

instance Data.ToHeaders ListResourceDelegates where
  toHeaders :: ListResourceDelegates -> 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
"WorkMailService.ListResourceDelegates" ::
                          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 ListResourceDelegates where
  toJSON :: ListResourceDelegates -> Value
toJSON ListResourceDelegates' {Maybe Natural
Maybe Text
Text
resourceId :: Text
organizationId :: Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
$sel:resourceId:ListResourceDelegates' :: ListResourceDelegates -> Text
$sel:organizationId:ListResourceDelegates' :: ListResourceDelegates -> Text
$sel:nextToken:ListResourceDelegates' :: ListResourceDelegates -> Maybe Text
$sel:maxResults:ListResourceDelegates' :: ListResourceDelegates -> 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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"OrganizationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationId),
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId)
          ]
      )

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

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

-- | /See:/ 'newListResourceDelegatesResponse' smart constructor.
data ListResourceDelegatesResponse = ListResourceDelegatesResponse'
  { -- | One page of the resource\'s delegates.
    ListResourceDelegatesResponse -> Maybe [Delegate]
delegates :: Prelude.Maybe [Delegate],
    -- | The token used to paginate through the delegates associated with a
    -- resource. While results are still available, it has an associated value.
    -- When the last page is reached, the token is empty.
    ListResourceDelegatesResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListResourceDelegatesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListResourceDelegatesResponse
-> ListResourceDelegatesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListResourceDelegatesResponse
-> ListResourceDelegatesResponse -> Bool
$c/= :: ListResourceDelegatesResponse
-> ListResourceDelegatesResponse -> Bool
== :: ListResourceDelegatesResponse
-> ListResourceDelegatesResponse -> Bool
$c== :: ListResourceDelegatesResponse
-> ListResourceDelegatesResponse -> Bool
Prelude.Eq, ReadPrec [ListResourceDelegatesResponse]
ReadPrec ListResourceDelegatesResponse
Int -> ReadS ListResourceDelegatesResponse
ReadS [ListResourceDelegatesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListResourceDelegatesResponse]
$creadListPrec :: ReadPrec [ListResourceDelegatesResponse]
readPrec :: ReadPrec ListResourceDelegatesResponse
$creadPrec :: ReadPrec ListResourceDelegatesResponse
readList :: ReadS [ListResourceDelegatesResponse]
$creadList :: ReadS [ListResourceDelegatesResponse]
readsPrec :: Int -> ReadS ListResourceDelegatesResponse
$creadsPrec :: Int -> ReadS ListResourceDelegatesResponse
Prelude.Read, Int -> ListResourceDelegatesResponse -> ShowS
[ListResourceDelegatesResponse] -> ShowS
ListResourceDelegatesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListResourceDelegatesResponse] -> ShowS
$cshowList :: [ListResourceDelegatesResponse] -> ShowS
show :: ListResourceDelegatesResponse -> String
$cshow :: ListResourceDelegatesResponse -> String
showsPrec :: Int -> ListResourceDelegatesResponse -> ShowS
$cshowsPrec :: Int -> ListResourceDelegatesResponse -> ShowS
Prelude.Show, forall x.
Rep ListResourceDelegatesResponse x
-> ListResourceDelegatesResponse
forall x.
ListResourceDelegatesResponse
-> Rep ListResourceDelegatesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListResourceDelegatesResponse x
-> ListResourceDelegatesResponse
$cfrom :: forall x.
ListResourceDelegatesResponse
-> Rep ListResourceDelegatesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListResourceDelegatesResponse' 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:
--
-- 'delegates', 'listResourceDelegatesResponse_delegates' - One page of the resource\'s delegates.
--
-- 'nextToken', 'listResourceDelegatesResponse_nextToken' - The token used to paginate through the delegates associated with a
-- resource. While results are still available, it has an associated value.
-- When the last page is reached, the token is empty.
--
-- 'httpStatus', 'listResourceDelegatesResponse_httpStatus' - The response's http status code.
newListResourceDelegatesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListResourceDelegatesResponse
newListResourceDelegatesResponse :: Int -> ListResourceDelegatesResponse
newListResourceDelegatesResponse Int
pHttpStatus_ =
  ListResourceDelegatesResponse'
    { $sel:delegates:ListResourceDelegatesResponse' :: Maybe [Delegate]
delegates =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListResourceDelegatesResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListResourceDelegatesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | One page of the resource\'s delegates.
listResourceDelegatesResponse_delegates :: Lens.Lens' ListResourceDelegatesResponse (Prelude.Maybe [Delegate])
listResourceDelegatesResponse_delegates :: Lens' ListResourceDelegatesResponse (Maybe [Delegate])
listResourceDelegatesResponse_delegates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListResourceDelegatesResponse' {Maybe [Delegate]
delegates :: Maybe [Delegate]
$sel:delegates:ListResourceDelegatesResponse' :: ListResourceDelegatesResponse -> Maybe [Delegate]
delegates} -> Maybe [Delegate]
delegates) (\s :: ListResourceDelegatesResponse
s@ListResourceDelegatesResponse' {} Maybe [Delegate]
a -> ListResourceDelegatesResponse
s {$sel:delegates:ListResourceDelegatesResponse' :: Maybe [Delegate]
delegates = Maybe [Delegate]
a} :: ListResourceDelegatesResponse) 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 used to paginate through the delegates associated with a
-- resource. While results are still available, it has an associated value.
-- When the last page is reached, the token is empty.
listResourceDelegatesResponse_nextToken :: Lens.Lens' ListResourceDelegatesResponse (Prelude.Maybe Prelude.Text)
listResourceDelegatesResponse_nextToken :: Lens' ListResourceDelegatesResponse (Maybe Text)
listResourceDelegatesResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListResourceDelegatesResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListResourceDelegatesResponse' :: ListResourceDelegatesResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListResourceDelegatesResponse
s@ListResourceDelegatesResponse' {} Maybe Text
a -> ListResourceDelegatesResponse
s {$sel:nextToken:ListResourceDelegatesResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListResourceDelegatesResponse)

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

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