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

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

-- | Deletes the specified policy associated with the specified group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_DeleteGroupPolicy.html>
data DeleteGroupPolicy
    = DeleteGroupPolicy {
        DeleteGroupPolicy -> Text
dgpPolicyName :: Text
      -- ^ Name of the policy to be deleted.
      , DeleteGroupPolicy -> Text
dgpGroupName   :: Text
      -- ^ Name of the group with whom the policy is associated.
      }
    deriving (DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
(DeleteGroupPolicy -> DeleteGroupPolicy -> Bool)
-> (DeleteGroupPolicy -> DeleteGroupPolicy -> Bool)
-> Eq DeleteGroupPolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
== :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
$c/= :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
/= :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
Eq, Eq DeleteGroupPolicy
Eq DeleteGroupPolicy =>
(DeleteGroupPolicy -> DeleteGroupPolicy -> Ordering)
-> (DeleteGroupPolicy -> DeleteGroupPolicy -> Bool)
-> (DeleteGroupPolicy -> DeleteGroupPolicy -> Bool)
-> (DeleteGroupPolicy -> DeleteGroupPolicy -> Bool)
-> (DeleteGroupPolicy -> DeleteGroupPolicy -> Bool)
-> (DeleteGroupPolicy -> DeleteGroupPolicy -> DeleteGroupPolicy)
-> (DeleteGroupPolicy -> DeleteGroupPolicy -> DeleteGroupPolicy)
-> Ord DeleteGroupPolicy
DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
DeleteGroupPolicy -> DeleteGroupPolicy -> Ordering
DeleteGroupPolicy -> DeleteGroupPolicy -> DeleteGroupPolicy
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 :: DeleteGroupPolicy -> DeleteGroupPolicy -> Ordering
compare :: DeleteGroupPolicy -> DeleteGroupPolicy -> Ordering
$c< :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
< :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
$c<= :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
<= :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
$c> :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
> :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
$c>= :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
>= :: DeleteGroupPolicy -> DeleteGroupPolicy -> Bool
$cmax :: DeleteGroupPolicy -> DeleteGroupPolicy -> DeleteGroupPolicy
max :: DeleteGroupPolicy -> DeleteGroupPolicy -> DeleteGroupPolicy
$cmin :: DeleteGroupPolicy -> DeleteGroupPolicy -> DeleteGroupPolicy
min :: DeleteGroupPolicy -> DeleteGroupPolicy -> DeleteGroupPolicy
Ord, Int -> DeleteGroupPolicy -> ShowS
[DeleteGroupPolicy] -> ShowS
DeleteGroupPolicy -> String
(Int -> DeleteGroupPolicy -> ShowS)
-> (DeleteGroupPolicy -> String)
-> ([DeleteGroupPolicy] -> ShowS)
-> Show DeleteGroupPolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeleteGroupPolicy -> ShowS
showsPrec :: Int -> DeleteGroupPolicy -> ShowS
$cshow :: DeleteGroupPolicy -> String
show :: DeleteGroupPolicy -> String
$cshowList :: [DeleteGroupPolicy] -> ShowS
showList :: [DeleteGroupPolicy] -> ShowS
Show, Typeable)

instance SignQuery DeleteGroupPolicy where
    type ServiceConfiguration DeleteGroupPolicy = IamConfiguration
    signQuery :: forall queryType.
DeleteGroupPolicy
-> ServiceConfiguration DeleteGroupPolicy queryType
-> SignatureData
-> SignedQuery
signQuery DeleteGroupPolicy{Text
dgpPolicyName :: DeleteGroupPolicy -> Text
dgpGroupName :: DeleteGroupPolicy -> Text
dgpPolicyName :: Text
dgpGroupName :: Text
..}
        = ByteString
-> [(ByteString, Text)]
-> IamConfiguration queryType
-> SignatureData
-> SignedQuery
forall qt.
ByteString
-> [(ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction ByteString
"DeleteGroupPolicy" [
              (ByteString
"PolicyName", Text
dgpPolicyName)
            , (ByteString
"GroupName", Text
dgpGroupName)
            ]

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

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

instance Transaction DeleteGroupPolicy DeleteGroupPolicyResponse

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