{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
module Aws.Iam.Commands.GetUser
    ( GetUser(..)
    , GetUserResponse(..)
    , User(..)
    ) where

import           Aws.Core
import           Aws.Iam.Core
import           Aws.Iam.Internal
import           Control.Applicative
import           Data.Text           (Text)
import           Data.Typeable
import           Prelude

-- | Retreives information about the given user.
--
-- If a user name is not given, IAM determines the user name based on the
-- access key signing the request.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_GetUser.html>
data GetUser = GetUser (Maybe Text)
    deriving (GetUser -> GetUser -> Bool
(GetUser -> GetUser -> Bool)
-> (GetUser -> GetUser -> Bool) -> Eq GetUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetUser -> GetUser -> Bool
== :: GetUser -> GetUser -> Bool
$c/= :: GetUser -> GetUser -> Bool
/= :: GetUser -> GetUser -> Bool
Eq, Eq GetUser
Eq GetUser =>
(GetUser -> GetUser -> Ordering)
-> (GetUser -> GetUser -> Bool)
-> (GetUser -> GetUser -> Bool)
-> (GetUser -> GetUser -> Bool)
-> (GetUser -> GetUser -> Bool)
-> (GetUser -> GetUser -> GetUser)
-> (GetUser -> GetUser -> GetUser)
-> Ord GetUser
GetUser -> GetUser -> Bool
GetUser -> GetUser -> Ordering
GetUser -> GetUser -> GetUser
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
$ccompare :: GetUser -> GetUser -> Ordering
compare :: GetUser -> GetUser -> Ordering
$c< :: GetUser -> GetUser -> Bool
< :: GetUser -> GetUser -> Bool
$c<= :: GetUser -> GetUser -> Bool
<= :: GetUser -> GetUser -> Bool
$c> :: GetUser -> GetUser -> Bool
> :: GetUser -> GetUser -> Bool
$c>= :: GetUser -> GetUser -> Bool
>= :: GetUser -> GetUser -> Bool
$cmax :: GetUser -> GetUser -> GetUser
max :: GetUser -> GetUser -> GetUser
$cmin :: GetUser -> GetUser -> GetUser
min :: GetUser -> GetUser -> GetUser
Ord, Int -> GetUser -> ShowS
[GetUser] -> ShowS
GetUser -> String
(Int -> GetUser -> ShowS)
-> (GetUser -> String) -> ([GetUser] -> ShowS) -> Show GetUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetUser -> ShowS
showsPrec :: Int -> GetUser -> ShowS
$cshow :: GetUser -> String
show :: GetUser -> String
$cshowList :: [GetUser] -> ShowS
showList :: [GetUser] -> ShowS
Show, Typeable)

instance SignQuery GetUser where
    type ServiceConfiguration GetUser = IamConfiguration
    signQuery :: forall queryType.
GetUser
-> ServiceConfiguration GetUser queryType
-> SignatureData
-> SignedQuery
signQuery (GetUser Maybe Text
user)
        = ByteString
-> [Maybe (ByteString, Text)]
-> IamConfiguration queryType
-> SignatureData
-> SignedQuery
forall qt.
ByteString
-> [Maybe (ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction' ByteString
"GetUser" [(ByteString
"UserName",) (Text -> (ByteString, Text))
-> Maybe Text -> Maybe (ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
user]

data GetUserResponse = GetUserResponse User
    deriving (GetUserResponse -> GetUserResponse -> Bool
(GetUserResponse -> GetUserResponse -> Bool)
-> (GetUserResponse -> GetUserResponse -> Bool)
-> Eq GetUserResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GetUserResponse -> GetUserResponse -> Bool
== :: GetUserResponse -> GetUserResponse -> Bool
$c/= :: GetUserResponse -> GetUserResponse -> Bool
/= :: GetUserResponse -> GetUserResponse -> Bool
Eq, Eq GetUserResponse
Eq GetUserResponse =>
(GetUserResponse -> GetUserResponse -> Ordering)
-> (GetUserResponse -> GetUserResponse -> Bool)
-> (GetUserResponse -> GetUserResponse -> Bool)
-> (GetUserResponse -> GetUserResponse -> Bool)
-> (GetUserResponse -> GetUserResponse -> Bool)
-> (GetUserResponse -> GetUserResponse -> GetUserResponse)
-> (GetUserResponse -> GetUserResponse -> GetUserResponse)
-> Ord GetUserResponse
GetUserResponse -> GetUserResponse -> Bool
GetUserResponse -> GetUserResponse -> Ordering
GetUserResponse -> GetUserResponse -> GetUserResponse
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
$ccompare :: GetUserResponse -> GetUserResponse -> Ordering
compare :: GetUserResponse -> GetUserResponse -> Ordering
$c< :: GetUserResponse -> GetUserResponse -> Bool
< :: GetUserResponse -> GetUserResponse -> Bool
$c<= :: GetUserResponse -> GetUserResponse -> Bool
<= :: GetUserResponse -> GetUserResponse -> Bool
$c> :: GetUserResponse -> GetUserResponse -> Bool
> :: GetUserResponse -> GetUserResponse -> Bool
$c>= :: GetUserResponse -> GetUserResponse -> Bool
>= :: GetUserResponse -> GetUserResponse -> Bool
$cmax :: GetUserResponse -> GetUserResponse -> GetUserResponse
max :: GetUserResponse -> GetUserResponse -> GetUserResponse
$cmin :: GetUserResponse -> GetUserResponse -> GetUserResponse
min :: GetUserResponse -> GetUserResponse -> GetUserResponse
Ord, Int -> GetUserResponse -> ShowS
[GetUserResponse] -> ShowS
GetUserResponse -> String
(Int -> GetUserResponse -> ShowS)
-> (GetUserResponse -> String)
-> ([GetUserResponse] -> ShowS)
-> Show GetUserResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GetUserResponse -> ShowS
showsPrec :: Int -> GetUserResponse -> ShowS
$cshow :: GetUserResponse -> String
show :: GetUserResponse -> String
$cshowList :: [GetUserResponse] -> ShowS
showList :: [GetUserResponse] -> ShowS
Show, Typeable)

instance ResponseConsumer GetUser GetUserResponse where
    type ResponseMetadata GetUserResponse = IamMetadata
    responseConsumer :: Request
-> GetUser
-> IORef (ResponseMetadata GetUserResponse)
-> HTTPResponseConsumer GetUserResponse
responseConsumer Request
_ GetUser
_ = (Cursor -> Response IamMetadata GetUserResponse)
-> IORef IamMetadata -> HTTPResponseConsumer GetUserResponse
forall a.
(Cursor -> Response IamMetadata a)
-> IORef IamMetadata -> HTTPResponseConsumer a
iamResponseConsumer ((Cursor -> Response IamMetadata GetUserResponse)
 -> IORef IamMetadata -> HTTPResponseConsumer GetUserResponse)
-> (Cursor -> Response IamMetadata GetUserResponse)
-> IORef IamMetadata
-> HTTPResponseConsumer GetUserResponse
forall a b. (a -> b) -> a -> b
$
                           (User -> GetUserResponse)
-> Response IamMetadata User
-> Response IamMetadata GetUserResponse
forall a b.
(a -> b) -> Response IamMetadata a -> Response IamMetadata b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap User -> GetUserResponse
GetUserResponse (Response IamMetadata User -> Response IamMetadata GetUserResponse)
-> (Cursor -> Response IamMetadata User)
-> Cursor
-> Response IamMetadata GetUserResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> Response IamMetadata User
forall (m :: * -> *). MonadThrow m => Cursor -> m User
parseUser

instance Transaction GetUser GetUserResponse

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