{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
module Aws.Iam.Commands.ListUserPolicies
    ( ListUserPolicies(..)
    , ListUserPoliciesResponse(..)
    ) where

import           Aws.Core
import           Aws.Iam.Core
import           Aws.Iam.Internal
import           Data.Text        (Text)
import           Data.Typeable
import           Text.XML.Cursor  (content, laxElement, ($//), (&/))

-- | Lists the user policies associated with the specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_ListUserPolicies.html>
data ListUserPolicies
    = ListUserPolicies {
        ListUserPolicies -> Text
lupUserName :: Text
      -- ^ Policies associated with this user will be listed.
      , ListUserPolicies -> Maybe Text
lupMarker   :: Maybe Text
      -- ^ Used for paginating requests. Marks the position of the last
      -- request.
      , ListUserPolicies -> Maybe Integer
lupMaxItems :: Maybe Integer
      -- ^ Used for paginating requests. Specifies the maximum number of items
      -- to return in the response. Defaults to 100.
      }
    deriving (ListUserPolicies -> ListUserPolicies -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUserPolicies -> ListUserPolicies -> Bool
$c/= :: ListUserPolicies -> ListUserPolicies -> Bool
== :: ListUserPolicies -> ListUserPolicies -> Bool
$c== :: ListUserPolicies -> ListUserPolicies -> Bool
Eq, Eq ListUserPolicies
ListUserPolicies -> ListUserPolicies -> Bool
ListUserPolicies -> ListUserPolicies -> Ordering
ListUserPolicies -> ListUserPolicies -> ListUserPolicies
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListUserPolicies -> ListUserPolicies -> ListUserPolicies
$cmin :: ListUserPolicies -> ListUserPolicies -> ListUserPolicies
max :: ListUserPolicies -> ListUserPolicies -> ListUserPolicies
$cmax :: ListUserPolicies -> ListUserPolicies -> ListUserPolicies
>= :: ListUserPolicies -> ListUserPolicies -> Bool
$c>= :: ListUserPolicies -> ListUserPolicies -> Bool
> :: ListUserPolicies -> ListUserPolicies -> Bool
$c> :: ListUserPolicies -> ListUserPolicies -> Bool
<= :: ListUserPolicies -> ListUserPolicies -> Bool
$c<= :: ListUserPolicies -> ListUserPolicies -> Bool
< :: ListUserPolicies -> ListUserPolicies -> Bool
$c< :: ListUserPolicies -> ListUserPolicies -> Bool
compare :: ListUserPolicies -> ListUserPolicies -> Ordering
$ccompare :: ListUserPolicies -> ListUserPolicies -> Ordering
Ord, Int -> ListUserPolicies -> ShowS
[ListUserPolicies] -> ShowS
ListUserPolicies -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUserPolicies] -> ShowS
$cshowList :: [ListUserPolicies] -> ShowS
show :: ListUserPolicies -> String
$cshow :: ListUserPolicies -> String
showsPrec :: Int -> ListUserPolicies -> ShowS
$cshowsPrec :: Int -> ListUserPolicies -> ShowS
Show, Typeable)

instance SignQuery ListUserPolicies where
    type ServiceConfiguration ListUserPolicies = IamConfiguration
    signQuery :: forall queryType.
ListUserPolicies
-> ServiceConfiguration ListUserPolicies queryType
-> SignatureData
-> SignedQuery
signQuery ListUserPolicies{Maybe Integer
Maybe Text
Text
lupMaxItems :: Maybe Integer
lupMarker :: Maybe Text
lupUserName :: Text
lupMaxItems :: ListUserPolicies -> Maybe Integer
lupMarker :: ListUserPolicies -> Maybe Text
lupUserName :: ListUserPolicies -> Text
..}
        = forall qt.
ByteString
-> [Maybe (ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction' ByteString
"ListUserPolicies" forall a b. (a -> b) -> a -> b
$ [
              forall a. a -> Maybe a
Just (ByteString
"UserName", Text
lupUserName)
            ] forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Maybe Integer -> [Maybe (ByteString, Text)]
markedIter Maybe Text
lupMarker Maybe Integer
lupMaxItems

data ListUserPoliciesResponse
    = ListUserPoliciesResponse {
        ListUserPoliciesResponse -> [Text]
luprPolicyNames :: [Text]
      -- ^ List of policy names.
      , ListUserPoliciesResponse -> Bool
luprIsTruncated :: Bool
      -- ^ @True@ if the request was truncated because of too many items.
      , ListUserPoliciesResponse -> Maybe Text
luprMarker      :: Maybe Text
      -- ^ Marks the position at which the request was truncated. This value
      -- must be passed with the next request to continue listing from the
      -- last position.
      }
    deriving (ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
$c/= :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
== :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
$c== :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
Eq, Eq ListUserPoliciesResponse
ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
ListUserPoliciesResponse -> ListUserPoliciesResponse -> Ordering
ListUserPoliciesResponse
-> ListUserPoliciesResponse -> ListUserPoliciesResponse
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ListUserPoliciesResponse
-> ListUserPoliciesResponse -> ListUserPoliciesResponse
$cmin :: ListUserPoliciesResponse
-> ListUserPoliciesResponse -> ListUserPoliciesResponse
max :: ListUserPoliciesResponse
-> ListUserPoliciesResponse -> ListUserPoliciesResponse
$cmax :: ListUserPoliciesResponse
-> ListUserPoliciesResponse -> ListUserPoliciesResponse
>= :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
$c>= :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
> :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
$c> :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
<= :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
$c<= :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
< :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
$c< :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Bool
compare :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Ordering
$ccompare :: ListUserPoliciesResponse -> ListUserPoliciesResponse -> Ordering
Ord, Int -> ListUserPoliciesResponse -> ShowS
[ListUserPoliciesResponse] -> ShowS
ListUserPoliciesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListUserPoliciesResponse] -> ShowS
$cshowList :: [ListUserPoliciesResponse] -> ShowS
show :: ListUserPoliciesResponse -> String
$cshow :: ListUserPoliciesResponse -> String
showsPrec :: Int -> ListUserPoliciesResponse -> ShowS
$cshowsPrec :: Int -> ListUserPoliciesResponse -> ShowS
Show, Typeable)

instance ResponseConsumer ListUserPolicies ListUserPoliciesResponse where
    type ResponseMetadata ListUserPoliciesResponse = IamMetadata
    responseConsumer :: Request
-> ListUserPolicies
-> IORef (ResponseMetadata ListUserPoliciesResponse)
-> HTTPResponseConsumer ListUserPoliciesResponse
responseConsumer Request
_ ListUserPolicies
_
        = forall a.
(Cursor -> Response IamMetadata a)
-> IORef IamMetadata -> HTTPResponseConsumer a
iamResponseConsumer forall a b. (a -> b) -> a -> b
$ \Cursor
cursor -> do
            (Bool
luprIsTruncated, Maybe Text
luprMarker) <- forall (m :: * -> *).
MonadThrow m =>
Cursor -> m (Bool, Maybe Text)
markedIterResponse Cursor
cursor
            let luprPolicyNames :: [Text]
luprPolicyNames = Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
laxElement Text
"member" forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
            forall (m :: * -> *) a. Monad m => a -> m a
return ListUserPoliciesResponse{Bool
[Text]
Maybe Text
luprPolicyNames :: [Text]
luprMarker :: Maybe Text
luprIsTruncated :: Bool
luprMarker :: Maybe Text
luprIsTruncated :: Bool
luprPolicyNames :: [Text]
..}

instance Transaction ListUserPolicies ListUserPoliciesResponse

instance IteratedTransaction ListUserPolicies ListUserPoliciesResponse where
    nextIteratedRequest :: ListUserPolicies
-> ListUserPoliciesResponse -> Maybe ListUserPolicies
nextIteratedRequest ListUserPolicies
request ListUserPoliciesResponse
response
        = case ListUserPoliciesResponse -> Maybe Text
luprMarker ListUserPoliciesResponse
response of
            Maybe Text
Nothing     -> forall a. Maybe a
Nothing
            Just Text
marker -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ListUserPolicies
request { lupMarker :: Maybe Text
lupMarker = forall a. a -> Maybe a
Just Text
marker }

instance AsMemoryResponse ListUserPoliciesResponse where
    type MemoryResponse ListUserPoliciesResponse = ListUserPoliciesResponse
    loadToMemory :: ListUserPoliciesResponse
-> ResourceT IO (MemoryResponse ListUserPoliciesResponse)
loadToMemory = forall (m :: * -> *) a. Monad m => a -> m a
return