{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TypeFamilies          #-}
module Aws.Iam.Commands.GetUserPolicy
    ( GetUserPolicy(..)
    , GetUserPolicyResponse(..)
    ) where

import           Aws.Core
import           Aws.Iam.Core
import           Aws.Iam.Internal
import           Control.Applicative
import           Data.Text           (Text)
import qualified Data.Text           as Text
import qualified Data.Text.Encoding  as Text
import           Data.Typeable
import qualified Network.HTTP.Types  as HTTP
import           Text.XML.Cursor     (($//))
import           Prelude

-- | Retreives the specified policy document for the specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_GetUserPolicy.html>
data GetUserPolicy
    = GetUserPolicy {
        GetUserPolicy -> Text
gupPolicyName :: Text
      -- ^ Name of the policy.
      , GetUserPolicy -> Text
gupUserName   :: Text
      -- ^ Name of the user with whom the policy is associated.
      }
    deriving (GetUserPolicy -> GetUserPolicy -> Bool
(GetUserPolicy -> GetUserPolicy -> Bool)
-> (GetUserPolicy -> GetUserPolicy -> Bool) -> Eq GetUserPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUserPolicy -> GetUserPolicy -> Bool
$c/= :: GetUserPolicy -> GetUserPolicy -> Bool
== :: GetUserPolicy -> GetUserPolicy -> Bool
$c== :: GetUserPolicy -> GetUserPolicy -> Bool
Eq, Eq GetUserPolicy
Eq GetUserPolicy
-> (GetUserPolicy -> GetUserPolicy -> Ordering)
-> (GetUserPolicy -> GetUserPolicy -> Bool)
-> (GetUserPolicy -> GetUserPolicy -> Bool)
-> (GetUserPolicy -> GetUserPolicy -> Bool)
-> (GetUserPolicy -> GetUserPolicy -> Bool)
-> (GetUserPolicy -> GetUserPolicy -> GetUserPolicy)
-> (GetUserPolicy -> GetUserPolicy -> GetUserPolicy)
-> Ord GetUserPolicy
GetUserPolicy -> GetUserPolicy -> Bool
GetUserPolicy -> GetUserPolicy -> Ordering
GetUserPolicy -> GetUserPolicy -> GetUserPolicy
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 :: GetUserPolicy -> GetUserPolicy -> GetUserPolicy
$cmin :: GetUserPolicy -> GetUserPolicy -> GetUserPolicy
max :: GetUserPolicy -> GetUserPolicy -> GetUserPolicy
$cmax :: GetUserPolicy -> GetUserPolicy -> GetUserPolicy
>= :: GetUserPolicy -> GetUserPolicy -> Bool
$c>= :: GetUserPolicy -> GetUserPolicy -> Bool
> :: GetUserPolicy -> GetUserPolicy -> Bool
$c> :: GetUserPolicy -> GetUserPolicy -> Bool
<= :: GetUserPolicy -> GetUserPolicy -> Bool
$c<= :: GetUserPolicy -> GetUserPolicy -> Bool
< :: GetUserPolicy -> GetUserPolicy -> Bool
$c< :: GetUserPolicy -> GetUserPolicy -> Bool
compare :: GetUserPolicy -> GetUserPolicy -> Ordering
$ccompare :: GetUserPolicy -> GetUserPolicy -> Ordering
$cp1Ord :: Eq GetUserPolicy
Ord, Int -> GetUserPolicy -> ShowS
[GetUserPolicy] -> ShowS
GetUserPolicy -> String
(Int -> GetUserPolicy -> ShowS)
-> (GetUserPolicy -> String)
-> ([GetUserPolicy] -> ShowS)
-> Show GetUserPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUserPolicy] -> ShowS
$cshowList :: [GetUserPolicy] -> ShowS
show :: GetUserPolicy -> String
$cshow :: GetUserPolicy -> String
showsPrec :: Int -> GetUserPolicy -> ShowS
$cshowsPrec :: Int -> GetUserPolicy -> ShowS
Show, Typeable)

instance SignQuery GetUserPolicy where
    type ServiceConfiguration GetUserPolicy = IamConfiguration
    signQuery :: GetUserPolicy
-> ServiceConfiguration GetUserPolicy queryType
-> SignatureData
-> SignedQuery
signQuery GetUserPolicy{Text
gupUserName :: Text
gupPolicyName :: Text
gupUserName :: GetUserPolicy -> Text
gupPolicyName :: GetUserPolicy -> Text
..}
        = ByteString
-> [(ByteString, Text)]
-> IamConfiguration queryType
-> SignatureData
-> SignedQuery
forall qt.
ByteString
-> [(ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction ByteString
"GetUserPolicy" [
              (ByteString
"PolicyName", Text
gupPolicyName)
            , (ByteString
"UserName", Text
gupUserName)
            ]

data GetUserPolicyResponse
    = GetUserPolicyResponse {
        GetUserPolicyResponse -> Text
guprPolicyDocument :: Text
      -- ^ The policy document.
      , GetUserPolicyResponse -> Text
guprPolicyName     :: Text
      -- ^ Name of the policy.
      , GetUserPolicyResponse -> Text
guprUserName       :: Text
      -- ^ Name of the user with whom the policy is associated.
      }
    deriving (GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
(GetUserPolicyResponse -> GetUserPolicyResponse -> Bool)
-> (GetUserPolicyResponse -> GetUserPolicyResponse -> Bool)
-> Eq GetUserPolicyResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
$c/= :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
== :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
$c== :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
Eq, Eq GetUserPolicyResponse
Eq GetUserPolicyResponse
-> (GetUserPolicyResponse -> GetUserPolicyResponse -> Ordering)
-> (GetUserPolicyResponse -> GetUserPolicyResponse -> Bool)
-> (GetUserPolicyResponse -> GetUserPolicyResponse -> Bool)
-> (GetUserPolicyResponse -> GetUserPolicyResponse -> Bool)
-> (GetUserPolicyResponse -> GetUserPolicyResponse -> Bool)
-> (GetUserPolicyResponse
    -> GetUserPolicyResponse -> GetUserPolicyResponse)
-> (GetUserPolicyResponse
    -> GetUserPolicyResponse -> GetUserPolicyResponse)
-> Ord GetUserPolicyResponse
GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
GetUserPolicyResponse -> GetUserPolicyResponse -> Ordering
GetUserPolicyResponse
-> GetUserPolicyResponse -> GetUserPolicyResponse
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 :: GetUserPolicyResponse
-> GetUserPolicyResponse -> GetUserPolicyResponse
$cmin :: GetUserPolicyResponse
-> GetUserPolicyResponse -> GetUserPolicyResponse
max :: GetUserPolicyResponse
-> GetUserPolicyResponse -> GetUserPolicyResponse
$cmax :: GetUserPolicyResponse
-> GetUserPolicyResponse -> GetUserPolicyResponse
>= :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
$c>= :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
> :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
$c> :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
<= :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
$c<= :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
< :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
$c< :: GetUserPolicyResponse -> GetUserPolicyResponse -> Bool
compare :: GetUserPolicyResponse -> GetUserPolicyResponse -> Ordering
$ccompare :: GetUserPolicyResponse -> GetUserPolicyResponse -> Ordering
$cp1Ord :: Eq GetUserPolicyResponse
Ord, Int -> GetUserPolicyResponse -> ShowS
[GetUserPolicyResponse] -> ShowS
GetUserPolicyResponse -> String
(Int -> GetUserPolicyResponse -> ShowS)
-> (GetUserPolicyResponse -> String)
-> ([GetUserPolicyResponse] -> ShowS)
-> Show GetUserPolicyResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUserPolicyResponse] -> ShowS
$cshowList :: [GetUserPolicyResponse] -> ShowS
show :: GetUserPolicyResponse -> String
$cshow :: GetUserPolicyResponse -> String
showsPrec :: Int -> GetUserPolicyResponse -> ShowS
$cshowsPrec :: Int -> GetUserPolicyResponse -> ShowS
Show, Typeable)

instance ResponseConsumer GetUserPolicy GetUserPolicyResponse where
    type ResponseMetadata GetUserPolicyResponse = IamMetadata
    responseConsumer :: Request
-> GetUserPolicy
-> IORef (ResponseMetadata GetUserPolicyResponse)
-> HTTPResponseConsumer GetUserPolicyResponse
responseConsumer Request
_ GetUserPolicy
_
        = (Cursor -> Response IamMetadata GetUserPolicyResponse)
-> IORef IamMetadata -> HTTPResponseConsumer GetUserPolicyResponse
forall a.
(Cursor -> Response IamMetadata a)
-> IORef IamMetadata -> HTTPResponseConsumer a
iamResponseConsumer ((Cursor -> Response IamMetadata GetUserPolicyResponse)
 -> IORef IamMetadata -> HTTPResponseConsumer GetUserPolicyResponse)
-> (Cursor -> Response IamMetadata GetUserPolicyResponse)
-> IORef IamMetadata
-> HTTPResponseConsumer GetUserPolicyResponse
forall a b. (a -> b) -> a -> b
$ \Cursor
cursor -> do
            let attr :: Text -> Response IamMetadata Text
attr Text
name = String -> [Text] -> Response IamMetadata Text
forall (m :: * -> *) a. MonadThrow m => String -> [a] -> m a
force (String
"Missing " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
Text.unpack Text
name) ([Text] -> Response IamMetadata Text)
-> [Text] -> Response IamMetadata Text
forall a b. (a -> b) -> a -> b
$
                            Cursor
cursor Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$// Text -> Cursor -> [Text]
elContent Text
name
            Text
guprPolicyDocument <- Text -> Text
decodePolicy (Text -> Text)
-> Response IamMetadata Text -> Response IamMetadata Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                                  Text -> Response IamMetadata Text
attr Text
"PolicyDocument"
            Text
guprPolicyName     <- Text -> Response IamMetadata Text
attr Text
"PolicyName"
            Text
guprUserName       <- Text -> Response IamMetadata Text
attr Text
"UserName"
            GetUserPolicyResponse -> Response IamMetadata GetUserPolicyResponse
forall (m :: * -> *) a. Monad m => a -> m a
return GetUserPolicyResponse :: Text -> Text -> Text -> GetUserPolicyResponse
GetUserPolicyResponse{Text
guprUserName :: Text
guprPolicyName :: Text
guprPolicyDocument :: Text
guprUserName :: Text
guprPolicyName :: Text
guprPolicyDocument :: Text
..}
        where
          decodePolicy :: Text -> Text
decodePolicy = ByteString -> Text
Text.decodeUtf8 (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
HTTP.urlDecode Bool
False
                       (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8


instance Transaction GetUserPolicy GetUserPolicyResponse

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