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

import           Aws.Core
import           Aws.Iam.Core
import           Aws.Iam.Internal
import           Data.Text        (Text)
import           Data.Typeable

-- | Adds a policy document with the specified name, associated with the
-- specified user.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_PutUserPolicy.html>
data PutUserPolicy
    = PutUserPolicy {
        PutUserPolicy -> Text
pupPolicyDocument :: Text
      -- ^ The policy document.
      , PutUserPolicy -> Text
pupPolicyName     :: Text
      -- ^ Name of the policy.
      , PutUserPolicy -> Text
pupUserName       :: Text
      -- ^ Name of the user with whom this policy is associated.
      }
    deriving (PutUserPolicy -> PutUserPolicy -> Bool
(PutUserPolicy -> PutUserPolicy -> Bool)
-> (PutUserPolicy -> PutUserPolicy -> Bool) -> Eq PutUserPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PutUserPolicy -> PutUserPolicy -> Bool
== :: PutUserPolicy -> PutUserPolicy -> Bool
$c/= :: PutUserPolicy -> PutUserPolicy -> Bool
/= :: PutUserPolicy -> PutUserPolicy -> Bool
Eq, Eq PutUserPolicy
Eq PutUserPolicy =>
(PutUserPolicy -> PutUserPolicy -> Ordering)
-> (PutUserPolicy -> PutUserPolicy -> Bool)
-> (PutUserPolicy -> PutUserPolicy -> Bool)
-> (PutUserPolicy -> PutUserPolicy -> Bool)
-> (PutUserPolicy -> PutUserPolicy -> Bool)
-> (PutUserPolicy -> PutUserPolicy -> PutUserPolicy)
-> (PutUserPolicy -> PutUserPolicy -> PutUserPolicy)
-> Ord PutUserPolicy
PutUserPolicy -> PutUserPolicy -> Bool
PutUserPolicy -> PutUserPolicy -> Ordering
PutUserPolicy -> PutUserPolicy -> PutUserPolicy
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 :: PutUserPolicy -> PutUserPolicy -> Ordering
compare :: PutUserPolicy -> PutUserPolicy -> Ordering
$c< :: PutUserPolicy -> PutUserPolicy -> Bool
< :: PutUserPolicy -> PutUserPolicy -> Bool
$c<= :: PutUserPolicy -> PutUserPolicy -> Bool
<= :: PutUserPolicy -> PutUserPolicy -> Bool
$c> :: PutUserPolicy -> PutUserPolicy -> Bool
> :: PutUserPolicy -> PutUserPolicy -> Bool
$c>= :: PutUserPolicy -> PutUserPolicy -> Bool
>= :: PutUserPolicy -> PutUserPolicy -> Bool
$cmax :: PutUserPolicy -> PutUserPolicy -> PutUserPolicy
max :: PutUserPolicy -> PutUserPolicy -> PutUserPolicy
$cmin :: PutUserPolicy -> PutUserPolicy -> PutUserPolicy
min :: PutUserPolicy -> PutUserPolicy -> PutUserPolicy
Ord, Int -> PutUserPolicy -> ShowS
[PutUserPolicy] -> ShowS
PutUserPolicy -> String
(Int -> PutUserPolicy -> ShowS)
-> (PutUserPolicy -> String)
-> ([PutUserPolicy] -> ShowS)
-> Show PutUserPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PutUserPolicy -> ShowS
showsPrec :: Int -> PutUserPolicy -> ShowS
$cshow :: PutUserPolicy -> String
show :: PutUserPolicy -> String
$cshowList :: [PutUserPolicy] -> ShowS
showList :: [PutUserPolicy] -> ShowS
Show, Typeable)

instance SignQuery PutUserPolicy where
    type ServiceConfiguration PutUserPolicy = IamConfiguration
    signQuery :: forall queryType.
PutUserPolicy
-> ServiceConfiguration PutUserPolicy queryType
-> SignatureData
-> SignedQuery
signQuery PutUserPolicy{Text
pupPolicyDocument :: PutUserPolicy -> Text
pupPolicyName :: PutUserPolicy -> Text
pupUserName :: PutUserPolicy -> Text
pupPolicyDocument :: Text
pupPolicyName :: Text
pupUserName :: Text
..}
        = ByteString
-> [(ByteString, Text)]
-> IamConfiguration queryType
-> SignatureData
-> SignedQuery
forall qt.
ByteString
-> [(ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction ByteString
"PutUserPolicy" [
              (ByteString
"PolicyDocument", Text
pupPolicyDocument)
            , (ByteString
"PolicyName"    , Text
pupPolicyName)
            , (ByteString
"UserName"      , Text
pupUserName)
            ]

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

instance ResponseConsumer PutUserPolicy PutUserPolicyResponse where
    type ResponseMetadata PutUserPolicyResponse = IamMetadata
    responseConsumer :: Request
-> PutUserPolicy
-> IORef (ResponseMetadata PutUserPolicyResponse)
-> HTTPResponseConsumer PutUserPolicyResponse
responseConsumer Request
_ PutUserPolicy
_
        = (Cursor -> Response IamMetadata PutUserPolicyResponse)
-> IORef IamMetadata -> HTTPResponseConsumer PutUserPolicyResponse
forall a.
(Cursor -> Response IamMetadata a)
-> IORef IamMetadata -> HTTPResponseConsumer a
iamResponseConsumer (Response IamMetadata PutUserPolicyResponse
-> Cursor -> Response IamMetadata PutUserPolicyResponse
forall a b. a -> b -> a
const (Response IamMetadata PutUserPolicyResponse
 -> Cursor -> Response IamMetadata PutUserPolicyResponse)
-> Response IamMetadata PutUserPolicyResponse
-> Cursor
-> Response IamMetadata PutUserPolicyResponse
forall a b. (a -> b) -> a -> b
$ PutUserPolicyResponse -> Response IamMetadata PutUserPolicyResponse
forall a. a -> Response IamMetadata a
forall (m :: * -> *) a. Monad m => a -> m a
return PutUserPolicyResponse
PutUserPolicyResponse)

instance Transaction PutUserPolicy PutUserPolicyResponse

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