{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TypeFamilies          #-}
module Aws.Iam.Commands.PutGroupPolicy
    ( PutGroupPolicy(..)
    , PutGroupPolicyResponse(..)
    ) 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 group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_PutGroupPolicy.html>
data PutGroupPolicy
    = PutGroupPolicy {
        PutGroupPolicy -> Text
pgpPolicyDocument :: Text
      -- ^ The policy document.
      , PutGroupPolicy -> Text
pgpPolicyName     :: Text
      -- ^ Name of the policy.
      , PutGroupPolicy -> Text
pgpGroupName       :: Text
      -- ^ Name of the group with whom this policy is associated.
      }
    deriving (PutGroupPolicy -> PutGroupPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutGroupPolicy -> PutGroupPolicy -> Bool
$c/= :: PutGroupPolicy -> PutGroupPolicy -> Bool
== :: PutGroupPolicy -> PutGroupPolicy -> Bool
$c== :: PutGroupPolicy -> PutGroupPolicy -> Bool
Eq, Eq PutGroupPolicy
PutGroupPolicy -> PutGroupPolicy -> Bool
PutGroupPolicy -> PutGroupPolicy -> Ordering
PutGroupPolicy -> PutGroupPolicy -> PutGroupPolicy
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 :: PutGroupPolicy -> PutGroupPolicy -> PutGroupPolicy
$cmin :: PutGroupPolicy -> PutGroupPolicy -> PutGroupPolicy
max :: PutGroupPolicy -> PutGroupPolicy -> PutGroupPolicy
$cmax :: PutGroupPolicy -> PutGroupPolicy -> PutGroupPolicy
>= :: PutGroupPolicy -> PutGroupPolicy -> Bool
$c>= :: PutGroupPolicy -> PutGroupPolicy -> Bool
> :: PutGroupPolicy -> PutGroupPolicy -> Bool
$c> :: PutGroupPolicy -> PutGroupPolicy -> Bool
<= :: PutGroupPolicy -> PutGroupPolicy -> Bool
$c<= :: PutGroupPolicy -> PutGroupPolicy -> Bool
< :: PutGroupPolicy -> PutGroupPolicy -> Bool
$c< :: PutGroupPolicy -> PutGroupPolicy -> Bool
compare :: PutGroupPolicy -> PutGroupPolicy -> Ordering
$ccompare :: PutGroupPolicy -> PutGroupPolicy -> Ordering
Ord, Int -> PutGroupPolicy -> ShowS
[PutGroupPolicy] -> ShowS
PutGroupPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutGroupPolicy] -> ShowS
$cshowList :: [PutGroupPolicy] -> ShowS
show :: PutGroupPolicy -> String
$cshow :: PutGroupPolicy -> String
showsPrec :: Int -> PutGroupPolicy -> ShowS
$cshowsPrec :: Int -> PutGroupPolicy -> ShowS
Show, Typeable)

instance SignQuery PutGroupPolicy where
    type ServiceConfiguration PutGroupPolicy = IamConfiguration
    signQuery :: forall queryType.
PutGroupPolicy
-> ServiceConfiguration PutGroupPolicy queryType
-> SignatureData
-> SignedQuery
signQuery PutGroupPolicy{Text
pgpGroupName :: Text
pgpPolicyName :: Text
pgpPolicyDocument :: Text
pgpGroupName :: PutGroupPolicy -> Text
pgpPolicyName :: PutGroupPolicy -> Text
pgpPolicyDocument :: PutGroupPolicy -> Text
..}
        = forall qt.
ByteString
-> [(ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction ByteString
"PutGroupPolicy" [
              (ByteString
"PolicyDocument", Text
pgpPolicyDocument)
            , (ByteString
"PolicyName"    , Text
pgpPolicyName)
            , (ByteString
"GroupName"      , Text
pgpGroupName)
            ]

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

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

instance Transaction PutGroupPolicy PutGroupPolicyResponse

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