{-# 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.IAM.ListAttachedUserPolicies
-- 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 all managed policies that are attached to the specified IAM user.
--
-- An IAM user can also have inline policies embedded with it. To list the
-- inline policies for a user, use ListUserPolicies. For information about
-- policies, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/policies-managed-vs-inline.html Managed policies and inline policies>
-- in the /IAM User Guide/.
--
-- You can paginate the results using the @MaxItems@ and @Marker@
-- parameters. You can use the @PathPrefix@ parameter to limit the list of
-- policies to only those matching the specified path prefix. If there are
-- no policies attached to the specified group (or none that match the
-- specified path prefix), the operation returns an empty list.
--
-- This operation returns paginated results.
module Amazonka.IAM.ListAttachedUserPolicies
  ( -- * Creating a Request
    ListAttachedUserPolicies (..),
    newListAttachedUserPolicies,

    -- * Request Lenses
    listAttachedUserPolicies_marker,
    listAttachedUserPolicies_maxItems,
    listAttachedUserPolicies_pathPrefix,
    listAttachedUserPolicies_userName,

    -- * Destructuring the Response
    ListAttachedUserPoliciesResponse (..),
    newListAttachedUserPoliciesResponse,

    -- * Response Lenses
    listAttachedUserPoliciesResponse_attachedPolicies,
    listAttachedUserPoliciesResponse_isTruncated,
    listAttachedUserPoliciesResponse_marker,
    listAttachedUserPoliciesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newListAttachedUserPolicies' smart constructor.
data ListAttachedUserPolicies = ListAttachedUserPolicies'
  { -- | Use this parameter only when paginating results and only after you
    -- receive a response indicating that the results are truncated. Set it to
    -- the value of the @Marker@ element in the response that you received to
    -- indicate where the next call should start.
    ListAttachedUserPolicies -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | Use this only when paginating results to indicate the maximum number of
    -- items you want in the response. If additional items exist beyond the
    -- maximum you specify, the @IsTruncated@ response element is @true@.
    --
    -- If you do not include this parameter, the number of items defaults to
    -- 100. Note that IAM might return fewer results, even when there are more
    -- results available. In that case, the @IsTruncated@ response element
    -- returns @true@, and @Marker@ contains a value to include in the
    -- subsequent call that tells the service where to continue from.
    ListAttachedUserPolicies -> Maybe Natural
maxItems :: Prelude.Maybe Prelude.Natural,
    -- | The path prefix for filtering the results. This parameter is optional.
    -- If it is not included, it defaults to a slash (\/), listing all
    -- policies.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of either a forward slash (\/) by itself or a string that
    -- must begin and end with forward slashes. In addition, it can contain any
    -- ASCII character from the ! (@\\u0021@) through the DEL character
    -- (@\\u007F@), including most punctuation characters, digits, and upper
    -- and lowercased letters.
    ListAttachedUserPolicies -> Maybe Text
pathPrefix :: Prelude.Maybe Prelude.Text,
    -- | The name (friendly name, not ARN) of the user to list attached policies
    -- for.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    ListAttachedUserPolicies -> Text
userName :: Prelude.Text
  }
  deriving (ListAttachedUserPolicies -> ListAttachedUserPolicies -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAttachedUserPolicies -> ListAttachedUserPolicies -> Bool
$c/= :: ListAttachedUserPolicies -> ListAttachedUserPolicies -> Bool
== :: ListAttachedUserPolicies -> ListAttachedUserPolicies -> Bool
$c== :: ListAttachedUserPolicies -> ListAttachedUserPolicies -> Bool
Prelude.Eq, ReadPrec [ListAttachedUserPolicies]
ReadPrec ListAttachedUserPolicies
Int -> ReadS ListAttachedUserPolicies
ReadS [ListAttachedUserPolicies]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAttachedUserPolicies]
$creadListPrec :: ReadPrec [ListAttachedUserPolicies]
readPrec :: ReadPrec ListAttachedUserPolicies
$creadPrec :: ReadPrec ListAttachedUserPolicies
readList :: ReadS [ListAttachedUserPolicies]
$creadList :: ReadS [ListAttachedUserPolicies]
readsPrec :: Int -> ReadS ListAttachedUserPolicies
$creadsPrec :: Int -> ReadS ListAttachedUserPolicies
Prelude.Read, Int -> ListAttachedUserPolicies -> ShowS
[ListAttachedUserPolicies] -> ShowS
ListAttachedUserPolicies -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAttachedUserPolicies] -> ShowS
$cshowList :: [ListAttachedUserPolicies] -> ShowS
show :: ListAttachedUserPolicies -> String
$cshow :: ListAttachedUserPolicies -> String
showsPrec :: Int -> ListAttachedUserPolicies -> ShowS
$cshowsPrec :: Int -> ListAttachedUserPolicies -> ShowS
Prelude.Show, forall x.
Rep ListAttachedUserPolicies x -> ListAttachedUserPolicies
forall x.
ListAttachedUserPolicies -> Rep ListAttachedUserPolicies x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListAttachedUserPolicies x -> ListAttachedUserPolicies
$cfrom :: forall x.
ListAttachedUserPolicies -> Rep ListAttachedUserPolicies x
Prelude.Generic)

-- |
-- Create a value of 'ListAttachedUserPolicies' 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:
--
-- 'marker', 'listAttachedUserPolicies_marker' - Use this parameter only when paginating results and only after you
-- receive a response indicating that the results are truncated. Set it to
-- the value of the @Marker@ element in the response that you received to
-- indicate where the next call should start.
--
-- 'maxItems', 'listAttachedUserPolicies_maxItems' - Use this only when paginating results to indicate the maximum number of
-- items you want in the response. If additional items exist beyond the
-- maximum you specify, the @IsTruncated@ response element is @true@.
--
-- If you do not include this parameter, the number of items defaults to
-- 100. Note that IAM might return fewer results, even when there are more
-- results available. In that case, the @IsTruncated@ response element
-- returns @true@, and @Marker@ contains a value to include in the
-- subsequent call that tells the service where to continue from.
--
-- 'pathPrefix', 'listAttachedUserPolicies_pathPrefix' - The path prefix for filtering the results. This parameter is optional.
-- If it is not included, it defaults to a slash (\/), listing all
-- policies.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
--
-- 'userName', 'listAttachedUserPolicies_userName' - The name (friendly name, not ARN) of the user to list attached policies
-- for.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
newListAttachedUserPolicies ::
  -- | 'userName'
  Prelude.Text ->
  ListAttachedUserPolicies
newListAttachedUserPolicies :: Text -> ListAttachedUserPolicies
newListAttachedUserPolicies Text
pUserName_ =
  ListAttachedUserPolicies'
    { $sel:marker:ListAttachedUserPolicies' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:maxItems:ListAttachedUserPolicies' :: Maybe Natural
maxItems = forall a. Maybe a
Prelude.Nothing,
      $sel:pathPrefix:ListAttachedUserPolicies' :: Maybe Text
pathPrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:userName:ListAttachedUserPolicies' :: Text
userName = Text
pUserName_
    }

-- | Use this parameter only when paginating results and only after you
-- receive a response indicating that the results are truncated. Set it to
-- the value of the @Marker@ element in the response that you received to
-- indicate where the next call should start.
listAttachedUserPolicies_marker :: Lens.Lens' ListAttachedUserPolicies (Prelude.Maybe Prelude.Text)
listAttachedUserPolicies_marker :: Lens' ListAttachedUserPolicies (Maybe Text)
listAttachedUserPolicies_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedUserPolicies' {Maybe Text
marker :: Maybe Text
$sel:marker:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListAttachedUserPolicies
s@ListAttachedUserPolicies' {} Maybe Text
a -> ListAttachedUserPolicies
s {$sel:marker:ListAttachedUserPolicies' :: Maybe Text
marker = Maybe Text
a} :: ListAttachedUserPolicies)

-- | Use this only when paginating results to indicate the maximum number of
-- items you want in the response. If additional items exist beyond the
-- maximum you specify, the @IsTruncated@ response element is @true@.
--
-- If you do not include this parameter, the number of items defaults to
-- 100. Note that IAM might return fewer results, even when there are more
-- results available. In that case, the @IsTruncated@ response element
-- returns @true@, and @Marker@ contains a value to include in the
-- subsequent call that tells the service where to continue from.
listAttachedUserPolicies_maxItems :: Lens.Lens' ListAttachedUserPolicies (Prelude.Maybe Prelude.Natural)
listAttachedUserPolicies_maxItems :: Lens' ListAttachedUserPolicies (Maybe Natural)
listAttachedUserPolicies_maxItems = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedUserPolicies' {Maybe Natural
maxItems :: Maybe Natural
$sel:maxItems:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Natural
maxItems} -> Maybe Natural
maxItems) (\s :: ListAttachedUserPolicies
s@ListAttachedUserPolicies' {} Maybe Natural
a -> ListAttachedUserPolicies
s {$sel:maxItems:ListAttachedUserPolicies' :: Maybe Natural
maxItems = Maybe Natural
a} :: ListAttachedUserPolicies)

-- | The path prefix for filtering the results. This parameter is optional.
-- If it is not included, it defaults to a slash (\/), listing all
-- policies.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of either a forward slash (\/) by itself or a string that
-- must begin and end with forward slashes. In addition, it can contain any
-- ASCII character from the ! (@\\u0021@) through the DEL character
-- (@\\u007F@), including most punctuation characters, digits, and upper
-- and lowercased letters.
listAttachedUserPolicies_pathPrefix :: Lens.Lens' ListAttachedUserPolicies (Prelude.Maybe Prelude.Text)
listAttachedUserPolicies_pathPrefix :: Lens' ListAttachedUserPolicies (Maybe Text)
listAttachedUserPolicies_pathPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedUserPolicies' {Maybe Text
pathPrefix :: Maybe Text
$sel:pathPrefix:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Text
pathPrefix} -> Maybe Text
pathPrefix) (\s :: ListAttachedUserPolicies
s@ListAttachedUserPolicies' {} Maybe Text
a -> ListAttachedUserPolicies
s {$sel:pathPrefix:ListAttachedUserPolicies' :: Maybe Text
pathPrefix = Maybe Text
a} :: ListAttachedUserPolicies)

-- | The name (friendly name, not ARN) of the user to list attached policies
-- for.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
listAttachedUserPolicies_userName :: Lens.Lens' ListAttachedUserPolicies Prelude.Text
listAttachedUserPolicies_userName :: Lens' ListAttachedUserPolicies Text
listAttachedUserPolicies_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedUserPolicies' {Text
userName :: Text
$sel:userName:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Text
userName} -> Text
userName) (\s :: ListAttachedUserPolicies
s@ListAttachedUserPolicies' {} Text
a -> ListAttachedUserPolicies
s {$sel:userName:ListAttachedUserPolicies' :: Text
userName = Text
a} :: ListAttachedUserPolicies)

instance Core.AWSPager ListAttachedUserPolicies where
  page :: ListAttachedUserPolicies
-> AWSResponse ListAttachedUserPolicies
-> Maybe ListAttachedUserPolicies
page ListAttachedUserPolicies
rq AWSResponse ListAttachedUserPolicies
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListAttachedUserPolicies
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAttachedUserPoliciesResponse (Maybe Bool)
listAttachedUserPoliciesResponse_isTruncated
            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. Maybe a -> Bool
Prelude.isNothing
        ( AWSResponse ListAttachedUserPolicies
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAttachedUserPoliciesResponse (Maybe Text)
listAttachedUserPoliciesResponse_marker
            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.$ ListAttachedUserPolicies
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListAttachedUserPolicies (Maybe Text)
listAttachedUserPolicies_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListAttachedUserPolicies
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListAttachedUserPoliciesResponse (Maybe Text)
listAttachedUserPoliciesResponse_marker
          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 ListAttachedUserPolicies where
  type
    AWSResponse ListAttachedUserPolicies =
      ListAttachedUserPoliciesResponse
  request :: (Service -> Service)
-> ListAttachedUserPolicies -> Request ListAttachedUserPolicies
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy ListAttachedUserPolicies
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListAttachedUserPolicies)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"ListAttachedUserPoliciesResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [AttachedPolicy]
-> Maybe Bool
-> Maybe Text
-> Int
-> ListAttachedUserPoliciesResponse
ListAttachedUserPoliciesResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AttachedPolicies"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"IsTruncated")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Marker")
            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 ListAttachedUserPolicies where
  hashWithSalt :: Int -> ListAttachedUserPolicies -> Int
hashWithSalt Int
_salt ListAttachedUserPolicies' {Maybe Natural
Maybe Text
Text
userName :: Text
pathPrefix :: Maybe Text
maxItems :: Maybe Natural
marker :: Maybe Text
$sel:userName:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Text
$sel:pathPrefix:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Text
$sel:maxItems:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Natural
$sel:marker:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxItems
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pathPrefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userName

instance Prelude.NFData ListAttachedUserPolicies where
  rnf :: ListAttachedUserPolicies -> ()
rnf ListAttachedUserPolicies' {Maybe Natural
Maybe Text
Text
userName :: Text
pathPrefix :: Maybe Text
maxItems :: Maybe Natural
marker :: Maybe Text
$sel:userName:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Text
$sel:pathPrefix:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Text
$sel:maxItems:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Natural
$sel:marker:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxItems
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pathPrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
userName

instance Data.ToHeaders ListAttachedUserPolicies where
  toHeaders :: ListAttachedUserPolicies -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery ListAttachedUserPolicies where
  toQuery :: ListAttachedUserPolicies -> QueryString
toQuery ListAttachedUserPolicies' {Maybe Natural
Maybe Text
Text
userName :: Text
pathPrefix :: Maybe Text
maxItems :: Maybe Natural
marker :: Maybe Text
$sel:userName:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Text
$sel:pathPrefix:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Text
$sel:maxItems:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Natural
$sel:marker:ListAttachedUserPolicies' :: ListAttachedUserPolicies -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ListAttachedUserPolicies" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"MaxItems" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxItems,
        ByteString
"PathPrefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
pathPrefix,
        ByteString
"UserName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
userName
      ]

-- | Contains the response to a successful ListAttachedUserPolicies request.
--
-- /See:/ 'newListAttachedUserPoliciesResponse' smart constructor.
data ListAttachedUserPoliciesResponse = ListAttachedUserPoliciesResponse'
  { -- | A list of the attached policies.
    ListAttachedUserPoliciesResponse -> Maybe [AttachedPolicy]
attachedPolicies :: Prelude.Maybe [AttachedPolicy],
    -- | A flag that indicates whether there are more items to return. If your
    -- results were truncated, you can make a subsequent pagination request
    -- using the @Marker@ request parameter to retrieve more items. Note that
    -- IAM might return fewer than the @MaxItems@ number of results even when
    -- there are more results available. We recommend that you check
    -- @IsTruncated@ after every call to ensure that you receive all your
    -- results.
    ListAttachedUserPoliciesResponse -> Maybe Bool
isTruncated :: Prelude.Maybe Prelude.Bool,
    -- | When @IsTruncated@ is @true@, this element is present and contains the
    -- value to use for the @Marker@ parameter in a subsequent pagination
    -- request.
    ListAttachedUserPoliciesResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListAttachedUserPoliciesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListAttachedUserPoliciesResponse
-> ListAttachedUserPoliciesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListAttachedUserPoliciesResponse
-> ListAttachedUserPoliciesResponse -> Bool
$c/= :: ListAttachedUserPoliciesResponse
-> ListAttachedUserPoliciesResponse -> Bool
== :: ListAttachedUserPoliciesResponse
-> ListAttachedUserPoliciesResponse -> Bool
$c== :: ListAttachedUserPoliciesResponse
-> ListAttachedUserPoliciesResponse -> Bool
Prelude.Eq, ReadPrec [ListAttachedUserPoliciesResponse]
ReadPrec ListAttachedUserPoliciesResponse
Int -> ReadS ListAttachedUserPoliciesResponse
ReadS [ListAttachedUserPoliciesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListAttachedUserPoliciesResponse]
$creadListPrec :: ReadPrec [ListAttachedUserPoliciesResponse]
readPrec :: ReadPrec ListAttachedUserPoliciesResponse
$creadPrec :: ReadPrec ListAttachedUserPoliciesResponse
readList :: ReadS [ListAttachedUserPoliciesResponse]
$creadList :: ReadS [ListAttachedUserPoliciesResponse]
readsPrec :: Int -> ReadS ListAttachedUserPoliciesResponse
$creadsPrec :: Int -> ReadS ListAttachedUserPoliciesResponse
Prelude.Read, Int -> ListAttachedUserPoliciesResponse -> ShowS
[ListAttachedUserPoliciesResponse] -> ShowS
ListAttachedUserPoliciesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListAttachedUserPoliciesResponse] -> ShowS
$cshowList :: [ListAttachedUserPoliciesResponse] -> ShowS
show :: ListAttachedUserPoliciesResponse -> String
$cshow :: ListAttachedUserPoliciesResponse -> String
showsPrec :: Int -> ListAttachedUserPoliciesResponse -> ShowS
$cshowsPrec :: Int -> ListAttachedUserPoliciesResponse -> ShowS
Prelude.Show, forall x.
Rep ListAttachedUserPoliciesResponse x
-> ListAttachedUserPoliciesResponse
forall x.
ListAttachedUserPoliciesResponse
-> Rep ListAttachedUserPoliciesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListAttachedUserPoliciesResponse x
-> ListAttachedUserPoliciesResponse
$cfrom :: forall x.
ListAttachedUserPoliciesResponse
-> Rep ListAttachedUserPoliciesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListAttachedUserPoliciesResponse' 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:
--
-- 'attachedPolicies', 'listAttachedUserPoliciesResponse_attachedPolicies' - A list of the attached policies.
--
-- 'isTruncated', 'listAttachedUserPoliciesResponse_isTruncated' - A flag that indicates whether there are more items to return. If your
-- results were truncated, you can make a subsequent pagination request
-- using the @Marker@ request parameter to retrieve more items. Note that
-- IAM might return fewer than the @MaxItems@ number of results even when
-- there are more results available. We recommend that you check
-- @IsTruncated@ after every call to ensure that you receive all your
-- results.
--
-- 'marker', 'listAttachedUserPoliciesResponse_marker' - When @IsTruncated@ is @true@, this element is present and contains the
-- value to use for the @Marker@ parameter in a subsequent pagination
-- request.
--
-- 'httpStatus', 'listAttachedUserPoliciesResponse_httpStatus' - The response's http status code.
newListAttachedUserPoliciesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListAttachedUserPoliciesResponse
newListAttachedUserPoliciesResponse :: Int -> ListAttachedUserPoliciesResponse
newListAttachedUserPoliciesResponse Int
pHttpStatus_ =
  ListAttachedUserPoliciesResponse'
    { $sel:attachedPolicies:ListAttachedUserPoliciesResponse' :: Maybe [AttachedPolicy]
attachedPolicies =
        forall a. Maybe a
Prelude.Nothing,
      $sel:isTruncated:ListAttachedUserPoliciesResponse' :: Maybe Bool
isTruncated = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:ListAttachedUserPoliciesResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListAttachedUserPoliciesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of the attached policies.
listAttachedUserPoliciesResponse_attachedPolicies :: Lens.Lens' ListAttachedUserPoliciesResponse (Prelude.Maybe [AttachedPolicy])
listAttachedUserPoliciesResponse_attachedPolicies :: Lens' ListAttachedUserPoliciesResponse (Maybe [AttachedPolicy])
listAttachedUserPoliciesResponse_attachedPolicies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedUserPoliciesResponse' {Maybe [AttachedPolicy]
attachedPolicies :: Maybe [AttachedPolicy]
$sel:attachedPolicies:ListAttachedUserPoliciesResponse' :: ListAttachedUserPoliciesResponse -> Maybe [AttachedPolicy]
attachedPolicies} -> Maybe [AttachedPolicy]
attachedPolicies) (\s :: ListAttachedUserPoliciesResponse
s@ListAttachedUserPoliciesResponse' {} Maybe [AttachedPolicy]
a -> ListAttachedUserPoliciesResponse
s {$sel:attachedPolicies:ListAttachedUserPoliciesResponse' :: Maybe [AttachedPolicy]
attachedPolicies = Maybe [AttachedPolicy]
a} :: ListAttachedUserPoliciesResponse) 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

-- | A flag that indicates whether there are more items to return. If your
-- results were truncated, you can make a subsequent pagination request
-- using the @Marker@ request parameter to retrieve more items. Note that
-- IAM might return fewer than the @MaxItems@ number of results even when
-- there are more results available. We recommend that you check
-- @IsTruncated@ after every call to ensure that you receive all your
-- results.
listAttachedUserPoliciesResponse_isTruncated :: Lens.Lens' ListAttachedUserPoliciesResponse (Prelude.Maybe Prelude.Bool)
listAttachedUserPoliciesResponse_isTruncated :: Lens' ListAttachedUserPoliciesResponse (Maybe Bool)
listAttachedUserPoliciesResponse_isTruncated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedUserPoliciesResponse' {Maybe Bool
isTruncated :: Maybe Bool
$sel:isTruncated:ListAttachedUserPoliciesResponse' :: ListAttachedUserPoliciesResponse -> Maybe Bool
isTruncated} -> Maybe Bool
isTruncated) (\s :: ListAttachedUserPoliciesResponse
s@ListAttachedUserPoliciesResponse' {} Maybe Bool
a -> ListAttachedUserPoliciesResponse
s {$sel:isTruncated:ListAttachedUserPoliciesResponse' :: Maybe Bool
isTruncated = Maybe Bool
a} :: ListAttachedUserPoliciesResponse)

-- | When @IsTruncated@ is @true@, this element is present and contains the
-- value to use for the @Marker@ parameter in a subsequent pagination
-- request.
listAttachedUserPoliciesResponse_marker :: Lens.Lens' ListAttachedUserPoliciesResponse (Prelude.Maybe Prelude.Text)
listAttachedUserPoliciesResponse_marker :: Lens' ListAttachedUserPoliciesResponse (Maybe Text)
listAttachedUserPoliciesResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListAttachedUserPoliciesResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:ListAttachedUserPoliciesResponse' :: ListAttachedUserPoliciesResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: ListAttachedUserPoliciesResponse
s@ListAttachedUserPoliciesResponse' {} Maybe Text
a -> ListAttachedUserPoliciesResponse
s {$sel:marker:ListAttachedUserPoliciesResponse' :: Maybe Text
marker = Maybe Text
a} :: ListAttachedUserPoliciesResponse)

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

instance
  Prelude.NFData
    ListAttachedUserPoliciesResponse
  where
  rnf :: ListAttachedUserPoliciesResponse -> ()
rnf ListAttachedUserPoliciesResponse' {Int
Maybe Bool
Maybe [AttachedPolicy]
Maybe Text
httpStatus :: Int
marker :: Maybe Text
isTruncated :: Maybe Bool
attachedPolicies :: Maybe [AttachedPolicy]
$sel:httpStatus:ListAttachedUserPoliciesResponse' :: ListAttachedUserPoliciesResponse -> Int
$sel:marker:ListAttachedUserPoliciesResponse' :: ListAttachedUserPoliciesResponse -> Maybe Text
$sel:isTruncated:ListAttachedUserPoliciesResponse' :: ListAttachedUserPoliciesResponse -> Maybe Bool
$sel:attachedPolicies:ListAttachedUserPoliciesResponse' :: ListAttachedUserPoliciesResponse -> Maybe [AttachedPolicy]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttachedPolicy]
attachedPolicies
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
isTruncated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus