{-# 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.LicenseManagerUserSubscriptions.ListUserAssociations
-- 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 user associations for an identity provider.
--
-- This operation returns paginated results.
module Amazonka.LicenseManagerUserSubscriptions.ListUserAssociations
  ( -- * Creating a Request
    ListUserAssociations (..),
    newListUserAssociations,

    -- * Request Lenses
    listUserAssociations_filters,
    listUserAssociations_maxResults,
    listUserAssociations_nextToken,
    listUserAssociations_identityProvider,
    listUserAssociations_instanceId,

    -- * Destructuring the Response
    ListUserAssociationsResponse (..),
    newListUserAssociationsResponse,

    -- * Response Lenses
    listUserAssociationsResponse_instanceUserSummaries,
    listUserAssociationsResponse_nextToken,
    listUserAssociationsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListUserAssociations' smart constructor.
data ListUserAssociations = ListUserAssociations'
  { -- | An array of structures that you can use to filter the results to those
    -- that match one or more sets of key-value pairs that you specify.
    ListUserAssociations -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | Maximum number of results to return in a single call.
    ListUserAssociations -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    -- | Token for the next set of results.
    ListUserAssociations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | An object that specifies details for the identity provider.
    ListUserAssociations -> IdentityProvider
identityProvider :: IdentityProvider,
    -- | The ID of the EC2 instance, which provides user-based subscriptions.
    ListUserAssociations -> Text
instanceId :: Prelude.Text
  }
  deriving (ListUserAssociations -> ListUserAssociations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUserAssociations -> ListUserAssociations -> Bool
$c/= :: ListUserAssociations -> ListUserAssociations -> Bool
== :: ListUserAssociations -> ListUserAssociations -> Bool
$c== :: ListUserAssociations -> ListUserAssociations -> Bool
Prelude.Eq, ReadPrec [ListUserAssociations]
ReadPrec ListUserAssociations
Int -> ReadS ListUserAssociations
ReadS [ListUserAssociations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListUserAssociations]
$creadListPrec :: ReadPrec [ListUserAssociations]
readPrec :: ReadPrec ListUserAssociations
$creadPrec :: ReadPrec ListUserAssociations
readList :: ReadS [ListUserAssociations]
$creadList :: ReadS [ListUserAssociations]
readsPrec :: Int -> ReadS ListUserAssociations
$creadsPrec :: Int -> ReadS ListUserAssociations
Prelude.Read, Int -> ListUserAssociations -> ShowS
[ListUserAssociations] -> ShowS
ListUserAssociations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUserAssociations] -> ShowS
$cshowList :: [ListUserAssociations] -> ShowS
show :: ListUserAssociations -> String
$cshow :: ListUserAssociations -> String
showsPrec :: Int -> ListUserAssociations -> ShowS
$cshowsPrec :: Int -> ListUserAssociations -> ShowS
Prelude.Show, forall x. Rep ListUserAssociations x -> ListUserAssociations
forall x. ListUserAssociations -> Rep ListUserAssociations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListUserAssociations x -> ListUserAssociations
$cfrom :: forall x. ListUserAssociations -> Rep ListUserAssociations x
Prelude.Generic)

-- |
-- Create a value of 'ListUserAssociations' 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:
--
-- 'filters', 'listUserAssociations_filters' - An array of structures that you can use to filter the results to those
-- that match one or more sets of key-value pairs that you specify.
--
-- 'maxResults', 'listUserAssociations_maxResults' - Maximum number of results to return in a single call.
--
-- 'nextToken', 'listUserAssociations_nextToken' - Token for the next set of results.
--
-- 'identityProvider', 'listUserAssociations_identityProvider' - An object that specifies details for the identity provider.
--
-- 'instanceId', 'listUserAssociations_instanceId' - The ID of the EC2 instance, which provides user-based subscriptions.
newListUserAssociations ::
  -- | 'identityProvider'
  IdentityProvider ->
  -- | 'instanceId'
  Prelude.Text ->
  ListUserAssociations
newListUserAssociations :: IdentityProvider -> Text -> ListUserAssociations
newListUserAssociations
  IdentityProvider
pIdentityProvider_
  Text
pInstanceId_ =
    ListUserAssociations'
      { $sel:filters:ListUserAssociations' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
        $sel:maxResults:ListUserAssociations' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
        $sel:nextToken:ListUserAssociations' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
        $sel:identityProvider:ListUserAssociations' :: IdentityProvider
identityProvider = IdentityProvider
pIdentityProvider_,
        $sel:instanceId:ListUserAssociations' :: Text
instanceId = Text
pInstanceId_
      }

-- | An array of structures that you can use to filter the results to those
-- that match one or more sets of key-value pairs that you specify.
listUserAssociations_filters :: Lens.Lens' ListUserAssociations (Prelude.Maybe [Filter])
listUserAssociations_filters :: Lens' ListUserAssociations (Maybe [Filter])
listUserAssociations_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserAssociations' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:ListUserAssociations' :: ListUserAssociations -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: ListUserAssociations
s@ListUserAssociations' {} Maybe [Filter]
a -> ListUserAssociations
s {$sel:filters:ListUserAssociations' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: ListUserAssociations) 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

-- | Maximum number of results to return in a single call.
listUserAssociations_maxResults :: Lens.Lens' ListUserAssociations (Prelude.Maybe Prelude.Int)
listUserAssociations_maxResults :: Lens' ListUserAssociations (Maybe Int)
listUserAssociations_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserAssociations' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:ListUserAssociations' :: ListUserAssociations -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: ListUserAssociations
s@ListUserAssociations' {} Maybe Int
a -> ListUserAssociations
s {$sel:maxResults:ListUserAssociations' :: Maybe Int
maxResults = Maybe Int
a} :: ListUserAssociations)

-- | Token for the next set of results.
listUserAssociations_nextToken :: Lens.Lens' ListUserAssociations (Prelude.Maybe Prelude.Text)
listUserAssociations_nextToken :: Lens' ListUserAssociations (Maybe Text)
listUserAssociations_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserAssociations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListUserAssociations' :: ListUserAssociations -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListUserAssociations
s@ListUserAssociations' {} Maybe Text
a -> ListUserAssociations
s {$sel:nextToken:ListUserAssociations' :: Maybe Text
nextToken = Maybe Text
a} :: ListUserAssociations)

-- | An object that specifies details for the identity provider.
listUserAssociations_identityProvider :: Lens.Lens' ListUserAssociations IdentityProvider
listUserAssociations_identityProvider :: Lens' ListUserAssociations IdentityProvider
listUserAssociations_identityProvider = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserAssociations' {IdentityProvider
identityProvider :: IdentityProvider
$sel:identityProvider:ListUserAssociations' :: ListUserAssociations -> IdentityProvider
identityProvider} -> IdentityProvider
identityProvider) (\s :: ListUserAssociations
s@ListUserAssociations' {} IdentityProvider
a -> ListUserAssociations
s {$sel:identityProvider:ListUserAssociations' :: IdentityProvider
identityProvider = IdentityProvider
a} :: ListUserAssociations)

-- | The ID of the EC2 instance, which provides user-based subscriptions.
listUserAssociations_instanceId :: Lens.Lens' ListUserAssociations Prelude.Text
listUserAssociations_instanceId :: Lens' ListUserAssociations Text
listUserAssociations_instanceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserAssociations' {Text
instanceId :: Text
$sel:instanceId:ListUserAssociations' :: ListUserAssociations -> Text
instanceId} -> Text
instanceId) (\s :: ListUserAssociations
s@ListUserAssociations' {} Text
a -> ListUserAssociations
s {$sel:instanceId:ListUserAssociations' :: Text
instanceId = Text
a} :: ListUserAssociations)

instance Core.AWSPager ListUserAssociations where
  page :: ListUserAssociations
-> AWSResponse ListUserAssociations -> Maybe ListUserAssociations
page ListUserAssociations
rq AWSResponse ListUserAssociations
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListUserAssociations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListUserAssociationsResponse (Maybe Text)
listUserAssociationsResponse_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 ListUserAssociations
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListUserAssociationsResponse (Maybe [InstanceUserSummary])
listUserAssociationsResponse_instanceUserSummaries
            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.$ ListUserAssociations
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListUserAssociations (Maybe Text)
listUserAssociations_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListUserAssociations
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListUserAssociationsResponse (Maybe Text)
listUserAssociationsResponse_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 ListUserAssociations where
  type
    AWSResponse ListUserAssociations =
      ListUserAssociationsResponse
  request :: (Service -> Service)
-> ListUserAssociations -> Request ListUserAssociations
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 ListUserAssociations
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListUserAssociations)))
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 [InstanceUserSummary]
-> Maybe Text -> Int -> ListUserAssociationsResponse
ListUserAssociationsResponse'
            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
"InstanceUserSummaries"
                            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 ListUserAssociations where
  hashWithSalt :: Int -> ListUserAssociations -> Int
hashWithSalt Int
_salt ListUserAssociations' {Maybe Int
Maybe [Filter]
Maybe Text
Text
IdentityProvider
instanceId :: Text
identityProvider :: IdentityProvider
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
$sel:instanceId:ListUserAssociations' :: ListUserAssociations -> Text
$sel:identityProvider:ListUserAssociations' :: ListUserAssociations -> IdentityProvider
$sel:nextToken:ListUserAssociations' :: ListUserAssociations -> Maybe Text
$sel:maxResults:ListUserAssociations' :: ListUserAssociations -> Maybe Int
$sel:filters:ListUserAssociations' :: ListUserAssociations -> Maybe [Filter]
..} =
    Int
_salt
      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
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` IdentityProvider
identityProvider
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
instanceId

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

instance Data.ToHeaders ListUserAssociations where
  toHeaders :: ListUserAssociations -> 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.ToJSON ListUserAssociations where
  toJSON :: ListUserAssociations -> Value
toJSON ListUserAssociations' {Maybe Int
Maybe [Filter]
Maybe Text
Text
IdentityProvider
instanceId :: Text
identityProvider :: IdentityProvider
nextToken :: Maybe Text
maxResults :: Maybe Int
filters :: Maybe [Filter]
$sel:instanceId:ListUserAssociations' :: ListUserAssociations -> Text
$sel:identityProvider:ListUserAssociations' :: ListUserAssociations -> IdentityProvider
$sel:nextToken:ListUserAssociations' :: ListUserAssociations -> Maybe Text
$sel:maxResults:ListUserAssociations' :: ListUserAssociations -> Maybe Int
$sel:filters:ListUserAssociations' :: ListUserAssociations -> Maybe [Filter]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IdentityProvider" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= IdentityProvider
identityProvider),
            forall a. a -> Maybe a
Prelude.Just (Key
"InstanceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
instanceId)
          ]
      )

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

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

-- | /See:/ 'newListUserAssociationsResponse' smart constructor.
data ListUserAssociationsResponse = ListUserAssociationsResponse'
  { -- | Metadata that describes the list user association operation.
    ListUserAssociationsResponse -> Maybe [InstanceUserSummary]
instanceUserSummaries :: Prelude.Maybe [InstanceUserSummary],
    -- | Token for the next set of results.
    ListUserAssociationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListUserAssociationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListUserAssociationsResponse
-> ListUserAssociationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUserAssociationsResponse
-> ListUserAssociationsResponse -> Bool
$c/= :: ListUserAssociationsResponse
-> ListUserAssociationsResponse -> Bool
== :: ListUserAssociationsResponse
-> ListUserAssociationsResponse -> Bool
$c== :: ListUserAssociationsResponse
-> ListUserAssociationsResponse -> Bool
Prelude.Eq, ReadPrec [ListUserAssociationsResponse]
ReadPrec ListUserAssociationsResponse
Int -> ReadS ListUserAssociationsResponse
ReadS [ListUserAssociationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListUserAssociationsResponse]
$creadListPrec :: ReadPrec [ListUserAssociationsResponse]
readPrec :: ReadPrec ListUserAssociationsResponse
$creadPrec :: ReadPrec ListUserAssociationsResponse
readList :: ReadS [ListUserAssociationsResponse]
$creadList :: ReadS [ListUserAssociationsResponse]
readsPrec :: Int -> ReadS ListUserAssociationsResponse
$creadsPrec :: Int -> ReadS ListUserAssociationsResponse
Prelude.Read, Int -> ListUserAssociationsResponse -> ShowS
[ListUserAssociationsResponse] -> ShowS
ListUserAssociationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUserAssociationsResponse] -> ShowS
$cshowList :: [ListUserAssociationsResponse] -> ShowS
show :: ListUserAssociationsResponse -> String
$cshow :: ListUserAssociationsResponse -> String
showsPrec :: Int -> ListUserAssociationsResponse -> ShowS
$cshowsPrec :: Int -> ListUserAssociationsResponse -> ShowS
Prelude.Show, forall x.
Rep ListUserAssociationsResponse x -> ListUserAssociationsResponse
forall x.
ListUserAssociationsResponse -> Rep ListUserAssociationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListUserAssociationsResponse x -> ListUserAssociationsResponse
$cfrom :: forall x.
ListUserAssociationsResponse -> Rep ListUserAssociationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListUserAssociationsResponse' 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:
--
-- 'instanceUserSummaries', 'listUserAssociationsResponse_instanceUserSummaries' - Metadata that describes the list user association operation.
--
-- 'nextToken', 'listUserAssociationsResponse_nextToken' - Token for the next set of results.
--
-- 'httpStatus', 'listUserAssociationsResponse_httpStatus' - The response's http status code.
newListUserAssociationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListUserAssociationsResponse
newListUserAssociationsResponse :: Int -> ListUserAssociationsResponse
newListUserAssociationsResponse Int
pHttpStatus_ =
  ListUserAssociationsResponse'
    { $sel:instanceUserSummaries:ListUserAssociationsResponse' :: Maybe [InstanceUserSummary]
instanceUserSummaries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListUserAssociationsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListUserAssociationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Metadata that describes the list user association operation.
listUserAssociationsResponse_instanceUserSummaries :: Lens.Lens' ListUserAssociationsResponse (Prelude.Maybe [InstanceUserSummary])
listUserAssociationsResponse_instanceUserSummaries :: Lens' ListUserAssociationsResponse (Maybe [InstanceUserSummary])
listUserAssociationsResponse_instanceUserSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserAssociationsResponse' {Maybe [InstanceUserSummary]
instanceUserSummaries :: Maybe [InstanceUserSummary]
$sel:instanceUserSummaries:ListUserAssociationsResponse' :: ListUserAssociationsResponse -> Maybe [InstanceUserSummary]
instanceUserSummaries} -> Maybe [InstanceUserSummary]
instanceUserSummaries) (\s :: ListUserAssociationsResponse
s@ListUserAssociationsResponse' {} Maybe [InstanceUserSummary]
a -> ListUserAssociationsResponse
s {$sel:instanceUserSummaries:ListUserAssociationsResponse' :: Maybe [InstanceUserSummary]
instanceUserSummaries = Maybe [InstanceUserSummary]
a} :: ListUserAssociationsResponse) 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 for the next set of results.
listUserAssociationsResponse_nextToken :: Lens.Lens' ListUserAssociationsResponse (Prelude.Maybe Prelude.Text)
listUserAssociationsResponse_nextToken :: Lens' ListUserAssociationsResponse (Maybe Text)
listUserAssociationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListUserAssociationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListUserAssociationsResponse' :: ListUserAssociationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListUserAssociationsResponse
s@ListUserAssociationsResponse' {} Maybe Text
a -> ListUserAssociationsResponse
s {$sel:nextToken:ListUserAssociationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListUserAssociationsResponse)

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

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