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

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

-- | Changes the status of the specified access key.
--
-- <http://docs.aws.amazon.com/IAM/latest/APIReference/API_UpdateAccessKey.html>
data UpdateAccessKey
    = UpdateAccessKey {
        UpdateAccessKey -> Text
uakAccessKeyId :: Text
      -- ^ ID of the access key to update.
      , UpdateAccessKey -> AccessKeyStatus
uakStatus      :: AccessKeyStatus
      -- ^ New status of the access key.
      , UpdateAccessKey -> Maybe Text
uakUserName    :: Maybe Text
      -- ^ Name of the user to whom the access key belongs. If omitted, the
      -- user will be determined based on the access key used to sign the
      -- request.
      }
    deriving (UpdateAccessKey -> UpdateAccessKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateAccessKey -> UpdateAccessKey -> Bool
$c/= :: UpdateAccessKey -> UpdateAccessKey -> Bool
== :: UpdateAccessKey -> UpdateAccessKey -> Bool
$c== :: UpdateAccessKey -> UpdateAccessKey -> Bool
Eq, Eq UpdateAccessKey
UpdateAccessKey -> UpdateAccessKey -> Bool
UpdateAccessKey -> UpdateAccessKey -> Ordering
UpdateAccessKey -> UpdateAccessKey -> UpdateAccessKey
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 :: UpdateAccessKey -> UpdateAccessKey -> UpdateAccessKey
$cmin :: UpdateAccessKey -> UpdateAccessKey -> UpdateAccessKey
max :: UpdateAccessKey -> UpdateAccessKey -> UpdateAccessKey
$cmax :: UpdateAccessKey -> UpdateAccessKey -> UpdateAccessKey
>= :: UpdateAccessKey -> UpdateAccessKey -> Bool
$c>= :: UpdateAccessKey -> UpdateAccessKey -> Bool
> :: UpdateAccessKey -> UpdateAccessKey -> Bool
$c> :: UpdateAccessKey -> UpdateAccessKey -> Bool
<= :: UpdateAccessKey -> UpdateAccessKey -> Bool
$c<= :: UpdateAccessKey -> UpdateAccessKey -> Bool
< :: UpdateAccessKey -> UpdateAccessKey -> Bool
$c< :: UpdateAccessKey -> UpdateAccessKey -> Bool
compare :: UpdateAccessKey -> UpdateAccessKey -> Ordering
$ccompare :: UpdateAccessKey -> UpdateAccessKey -> Ordering
Ord, Int -> UpdateAccessKey -> ShowS
[UpdateAccessKey] -> ShowS
UpdateAccessKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateAccessKey] -> ShowS
$cshowList :: [UpdateAccessKey] -> ShowS
show :: UpdateAccessKey -> String
$cshow :: UpdateAccessKey -> String
showsPrec :: Int -> UpdateAccessKey -> ShowS
$cshowsPrec :: Int -> UpdateAccessKey -> ShowS
Show, Typeable)

instance SignQuery UpdateAccessKey where
    type ServiceConfiguration UpdateAccessKey = IamConfiguration
    signQuery :: forall queryType.
UpdateAccessKey
-> ServiceConfiguration UpdateAccessKey queryType
-> SignatureData
-> SignedQuery
signQuery UpdateAccessKey{Maybe Text
Text
AccessKeyStatus
uakUserName :: Maybe Text
uakStatus :: AccessKeyStatus
uakAccessKeyId :: Text
uakUserName :: UpdateAccessKey -> Maybe Text
uakStatus :: UpdateAccessKey -> AccessKeyStatus
uakAccessKeyId :: UpdateAccessKey -> Text
..}
        = forall qt.
ByteString
-> [Maybe (ByteString, Text)]
-> IamConfiguration qt
-> SignatureData
-> SignedQuery
iamAction' ByteString
"UpdateAccessKey" [
              forall a. a -> Maybe a
Just (ByteString
"AccessKeyId", Text
uakAccessKeyId)
            , forall a. a -> Maybe a
Just (ByteString
"Status", forall {a}. IsString a => AccessKeyStatus -> a
showStatus AccessKeyStatus
uakStatus)
            , (ByteString
"UserName",) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
uakUserName
            ]
        where
          showStatus :: AccessKeyStatus -> a
showStatus AccessKeyStatus
AccessKeyActive = a
"Active"
          showStatus AccessKeyStatus
_               = a
"Inactive"

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

instance ResponseConsumer UpdateAccessKey UpdateAccessKeyResponse where
    type ResponseMetadata UpdateAccessKeyResponse = IamMetadata
    responseConsumer :: Request
-> UpdateAccessKey
-> IORef (ResponseMetadata UpdateAccessKeyResponse)
-> HTTPResponseConsumer UpdateAccessKeyResponse
responseConsumer Request
_ UpdateAccessKey
_
        = 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 UpdateAccessKeyResponse
UpdateAccessKeyResponse)

instance Transaction UpdateAccessKey UpdateAccessKeyResponse

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