{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE TypeFamilies          #-}
module Aws.Iam.Commands.UpdateGroup
    ( UpdateGroup(..)
    , UpdateGroupResponse(..)
    ) where

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

-- | Updates the name and/or path of the specified group.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_UpdateGroup.html>
data UpdateGroup
    = UpdateGroup {
        UpdateGroup -> Text
ugGroupName    :: Text
      -- ^ Name of the group to be updated.
      , UpdateGroup -> Maybe Text
ugNewGroupName :: Maybe Text
      -- ^ New name for the group.
      , UpdateGroup -> Maybe Text
ugNewPath     :: Maybe Text
      -- ^ New path to which the group will be moved.
      }
    deriving (UpdateGroup -> UpdateGroup -> Bool
(UpdateGroup -> UpdateGroup -> Bool)
-> (UpdateGroup -> UpdateGroup -> Bool) -> Eq UpdateGroup
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UpdateGroup -> UpdateGroup -> Bool
== :: UpdateGroup -> UpdateGroup -> Bool
$c/= :: UpdateGroup -> UpdateGroup -> Bool
/= :: UpdateGroup -> UpdateGroup -> Bool
Eq, Eq UpdateGroup
Eq UpdateGroup =>
(UpdateGroup -> UpdateGroup -> Ordering)
-> (UpdateGroup -> UpdateGroup -> Bool)
-> (UpdateGroup -> UpdateGroup -> Bool)
-> (UpdateGroup -> UpdateGroup -> Bool)
-> (UpdateGroup -> UpdateGroup -> Bool)
-> (UpdateGroup -> UpdateGroup -> UpdateGroup)
-> (UpdateGroup -> UpdateGroup -> UpdateGroup)
-> Ord UpdateGroup
UpdateGroup -> UpdateGroup -> Bool
UpdateGroup -> UpdateGroup -> Ordering
UpdateGroup -> UpdateGroup -> UpdateGroup
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 :: UpdateGroup -> UpdateGroup -> Ordering
compare :: UpdateGroup -> UpdateGroup -> Ordering
$c< :: UpdateGroup -> UpdateGroup -> Bool
< :: UpdateGroup -> UpdateGroup -> Bool
$c<= :: UpdateGroup -> UpdateGroup -> Bool
<= :: UpdateGroup -> UpdateGroup -> Bool
$c> :: UpdateGroup -> UpdateGroup -> Bool
> :: UpdateGroup -> UpdateGroup -> Bool
$c>= :: UpdateGroup -> UpdateGroup -> Bool
>= :: UpdateGroup -> UpdateGroup -> Bool
$cmax :: UpdateGroup -> UpdateGroup -> UpdateGroup
max :: UpdateGroup -> UpdateGroup -> UpdateGroup
$cmin :: UpdateGroup -> UpdateGroup -> UpdateGroup
min :: UpdateGroup -> UpdateGroup -> UpdateGroup
Ord, Int -> UpdateGroup -> ShowS
[UpdateGroup] -> ShowS
UpdateGroup -> String
(Int -> UpdateGroup -> ShowS)
-> (UpdateGroup -> String)
-> ([UpdateGroup] -> ShowS)
-> Show UpdateGroup
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UpdateGroup -> ShowS
showsPrec :: Int -> UpdateGroup -> ShowS
$cshow :: UpdateGroup -> String
show :: UpdateGroup -> String
$cshowList :: [UpdateGroup] -> ShowS
showList :: [UpdateGroup] -> ShowS
Show, Typeable)

instance SignQuery UpdateGroup where
    type ServiceConfiguration UpdateGroup = IamConfiguration
    signQuery :: forall queryType.
UpdateGroup
-> ServiceConfiguration UpdateGroup queryType
-> SignatureData
-> SignedQuery
signQuery UpdateGroup{Maybe Text
Text
ugGroupName :: UpdateGroup -> Text
ugNewGroupName :: UpdateGroup -> Maybe Text
ugNewPath :: UpdateGroup -> Maybe Text
ugGroupName :: Text
ugNewGroupName :: Maybe Text
ugNewPath :: Maybe Text
..}
        = ByteString
-> [Maybe (ByteString, Text)]
-> IamConfiguration queryType
-> SignatureData
-> SignedQuery
forall qt.
ByteString
-> [Maybe (ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction' ByteString
"UpdateGroup" [
              (ByteString, Text) -> Maybe (ByteString, Text)
forall a. a -> Maybe a
Just (ByteString
"GroupName", Text
ugGroupName)
            , (ByteString
"NewGroupName",) (Text -> (ByteString, Text))
-> Maybe Text -> Maybe (ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
ugNewGroupName
            , (ByteString
"NewPath",) (Text -> (ByteString, Text))
-> Maybe Text -> Maybe (ByteString, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
ugNewPath
            ]

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

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

instance Transaction UpdateGroup UpdateGroupResponse

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