{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
module Aws.Iam.Commands.ListGroups
    ( ListGroups(..)
    , ListGroupsResponse(..)
    , Group(..)
    ) where

import           Aws.Core
import           Aws.Iam.Core
import           Aws.Iam.Internal
import           Control.Applicative
import           Data.Text           (Text)
import           Data.Typeable
import           Prelude
import           Text.XML.Cursor     (laxElement, ($//), (&|))

-- | Lists groups that have the specified path prefix.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_ListGroups.html>
data ListGroups
    = ListGroups {
        ListGroups -> Maybe Text
lgPathPrefix :: Maybe Text
      -- ^ Groups defined under this path will be listed. If omitted, defaults
      -- to @/@, which lists all groups.
      , ListGroups -> Maybe Text
lgMarker     :: Maybe Text
      -- ^ Used for paginating requests. Marks the position of the last
      -- request.
      , ListGroups -> Maybe Integer
lgMaxItems   :: Maybe Integer
      -- ^ Used for paginating requests. Specifies the maximum number of items
      -- to return in the response. Defaults to 100.
      }
    deriving (ListGroups -> ListGroups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListGroups -> ListGroups -> Bool
$c/= :: ListGroups -> ListGroups -> Bool
== :: ListGroups -> ListGroups -> Bool
$c== :: ListGroups -> ListGroups -> Bool
Eq, Eq ListGroups
ListGroups -> ListGroups -> Bool
ListGroups -> ListGroups -> Ordering
ListGroups -> ListGroups -> ListGroups
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 :: ListGroups -> ListGroups -> ListGroups
$cmin :: ListGroups -> ListGroups -> ListGroups
max :: ListGroups -> ListGroups -> ListGroups
$cmax :: ListGroups -> ListGroups -> ListGroups
>= :: ListGroups -> ListGroups -> Bool
$c>= :: ListGroups -> ListGroups -> Bool
> :: ListGroups -> ListGroups -> Bool
$c> :: ListGroups -> ListGroups -> Bool
<= :: ListGroups -> ListGroups -> Bool
$c<= :: ListGroups -> ListGroups -> Bool
< :: ListGroups -> ListGroups -> Bool
$c< :: ListGroups -> ListGroups -> Bool
compare :: ListGroups -> ListGroups -> Ordering
$ccompare :: ListGroups -> ListGroups -> Ordering
Ord, Int -> ListGroups -> ShowS
[ListGroups] -> ShowS
ListGroups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListGroups] -> ShowS
$cshowList :: [ListGroups] -> ShowS
show :: ListGroups -> String
$cshow :: ListGroups -> String
showsPrec :: Int -> ListGroups -> ShowS
$cshowsPrec :: Int -> ListGroups -> ShowS
Show, Typeable)

instance SignQuery ListGroups where
    type ServiceConfiguration ListGroups = IamConfiguration
    signQuery :: forall queryType.
ListGroups
-> ServiceConfiguration ListGroups queryType
-> SignatureData
-> SignedQuery
signQuery ListGroups{Maybe Integer
Maybe Text
lgMaxItems :: Maybe Integer
lgMarker :: Maybe Text
lgPathPrefix :: Maybe Text
lgMaxItems :: ListGroups -> Maybe Integer
lgMarker :: ListGroups -> Maybe Text
lgPathPrefix :: ListGroups -> Maybe Text
..}
        = forall qt.
ByteString
-> [Maybe (ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction' ByteString
"ListGroups" forall a b. (a -> b) -> a -> b
$ [
              (ByteString
"PathPrefix",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
lgPathPrefix
            ] forall a. Semigroup a => a -> a -> a
<> Maybe Text -> Maybe Integer -> [Maybe (ByteString, Text)]
markedIter Maybe Text
lgMarker Maybe Integer
lgMaxItems

data ListGroupsResponse
    = ListGroupsResponse {
        ListGroupsResponse -> [Group]
lgrGroups       :: [Group]
      -- ^ List of 'Group's.
      , ListGroupsResponse -> Bool
lgrIsTruncated :: Bool
      -- ^ @True@ if the request was truncated because of too many items.
      , ListGroupsResponse -> Maybe Text
lgrMarker      :: 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 (ListGroupsResponse -> ListGroupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListGroupsResponse -> ListGroupsResponse -> Bool
$c/= :: ListGroupsResponse -> ListGroupsResponse -> Bool
== :: ListGroupsResponse -> ListGroupsResponse -> Bool
$c== :: ListGroupsResponse -> ListGroupsResponse -> Bool
Eq, Eq ListGroupsResponse
ListGroupsResponse -> ListGroupsResponse -> Bool
ListGroupsResponse -> ListGroupsResponse -> Ordering
ListGroupsResponse -> ListGroupsResponse -> ListGroupsResponse
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 :: ListGroupsResponse -> ListGroupsResponse -> ListGroupsResponse
$cmin :: ListGroupsResponse -> ListGroupsResponse -> ListGroupsResponse
max :: ListGroupsResponse -> ListGroupsResponse -> ListGroupsResponse
$cmax :: ListGroupsResponse -> ListGroupsResponse -> ListGroupsResponse
>= :: ListGroupsResponse -> ListGroupsResponse -> Bool
$c>= :: ListGroupsResponse -> ListGroupsResponse -> Bool
> :: ListGroupsResponse -> ListGroupsResponse -> Bool
$c> :: ListGroupsResponse -> ListGroupsResponse -> Bool
<= :: ListGroupsResponse -> ListGroupsResponse -> Bool
$c<= :: ListGroupsResponse -> ListGroupsResponse -> Bool
< :: ListGroupsResponse -> ListGroupsResponse -> Bool
$c< :: ListGroupsResponse -> ListGroupsResponse -> Bool
compare :: ListGroupsResponse -> ListGroupsResponse -> Ordering
$ccompare :: ListGroupsResponse -> ListGroupsResponse -> Ordering
Ord, Int -> ListGroupsResponse -> ShowS
[ListGroupsResponse] -> ShowS
ListGroupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListGroupsResponse] -> ShowS
$cshowList :: [ListGroupsResponse] -> ShowS
show :: ListGroupsResponse -> String
$cshow :: ListGroupsResponse -> String
showsPrec :: Int -> ListGroupsResponse -> ShowS
$cshowsPrec :: Int -> ListGroupsResponse -> ShowS
Show, Typeable)

instance ResponseConsumer ListGroups ListGroupsResponse where
    type ResponseMetadata ListGroupsResponse = IamMetadata
    responseConsumer :: Request
-> ListGroups
-> IORef (ResponseMetadata ListGroupsResponse)
-> HTTPResponseConsumer ListGroupsResponse
responseConsumer Request
_ ListGroups
_
        = forall a.
(Cursor -> Response IamMetadata a)
-> IORef IamMetadata -> HTTPResponseConsumer a
iamResponseConsumer forall a b. (a -> b) -> a -> b
$ \Cursor
cursor -> do
            (Bool
lgrIsTruncated, Maybe Text
lgrMarker) <- forall (m :: * -> *).
MonadThrow m =>
Cursor -> m (Bool, Maybe Text)
markedIterResponse Cursor
cursor
            [Group]
lgrGroups <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$
                Cursor
cursor forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Axis
laxElement Text
"member" forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&| forall (m :: * -> *). MonadThrow m => Cursor -> m Group
parseGroup
            forall (m :: * -> *) a. Monad m => a -> m a
return ListGroupsResponse{Bool
[Group]
Maybe Text
lgrGroups :: [Group]
lgrMarker :: Maybe Text
lgrIsTruncated :: Bool
lgrMarker :: Maybe Text
lgrIsTruncated :: Bool
lgrGroups :: [Group]
..}

instance Transaction ListGroups ListGroupsResponse

instance IteratedTransaction ListGroups ListGroupsResponse where
    nextIteratedRequest :: ListGroups -> ListGroupsResponse -> Maybe ListGroups
nextIteratedRequest ListGroups
request ListGroupsResponse
response
        = case ListGroupsResponse -> Maybe Text
lgrMarker ListGroupsResponse
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
$ ListGroups
request { lgMarker :: Maybe Text
lgMarker = forall a. a -> Maybe a
Just Text
marker }

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