{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.IoT.UpdateRoleAlias
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a role alias.
--
-- Requires permission to access the
-- <https://docs.aws.amazon.com/service-authorization/latest/reference/list_awsiot.html#awsiot-actions-as-permissions UpdateRoleAlias>
-- action.
module Amazonka.IoT.UpdateRoleAlias
  ( -- * Creating a Request
    UpdateRoleAlias (..),
    newUpdateRoleAlias,

    -- * Request Lenses
    updateRoleAlias_credentialDurationSeconds,
    updateRoleAlias_roleArn,
    updateRoleAlias_roleAlias,

    -- * Destructuring the Response
    UpdateRoleAliasResponse (..),
    newUpdateRoleAliasResponse,

    -- * Response Lenses
    updateRoleAliasResponse_roleAlias,
    updateRoleAliasResponse_roleAliasArn,
    updateRoleAliasResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoT.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateRoleAlias' smart constructor.
data UpdateRoleAlias = UpdateRoleAlias'
  { -- | The number of seconds the credential will be valid.
    --
    -- This value must be less than or equal to the maximum session duration of
    -- the IAM role that the role alias references.
    UpdateRoleAlias -> Maybe Natural
credentialDurationSeconds :: Prelude.Maybe Prelude.Natural,
    -- | The role ARN.
    UpdateRoleAlias -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The role alias to update.
    UpdateRoleAlias -> Text
roleAlias :: Prelude.Text
  }
  deriving (UpdateRoleAlias -> UpdateRoleAlias -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRoleAlias -> UpdateRoleAlias -> Bool
$c/= :: UpdateRoleAlias -> UpdateRoleAlias -> Bool
== :: UpdateRoleAlias -> UpdateRoleAlias -> Bool
$c== :: UpdateRoleAlias -> UpdateRoleAlias -> Bool
Prelude.Eq, ReadPrec [UpdateRoleAlias]
ReadPrec UpdateRoleAlias
Int -> ReadS UpdateRoleAlias
ReadS [UpdateRoleAlias]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRoleAlias]
$creadListPrec :: ReadPrec [UpdateRoleAlias]
readPrec :: ReadPrec UpdateRoleAlias
$creadPrec :: ReadPrec UpdateRoleAlias
readList :: ReadS [UpdateRoleAlias]
$creadList :: ReadS [UpdateRoleAlias]
readsPrec :: Int -> ReadS UpdateRoleAlias
$creadsPrec :: Int -> ReadS UpdateRoleAlias
Prelude.Read, Int -> UpdateRoleAlias -> ShowS
[UpdateRoleAlias] -> ShowS
UpdateRoleAlias -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRoleAlias] -> ShowS
$cshowList :: [UpdateRoleAlias] -> ShowS
show :: UpdateRoleAlias -> String
$cshow :: UpdateRoleAlias -> String
showsPrec :: Int -> UpdateRoleAlias -> ShowS
$cshowsPrec :: Int -> UpdateRoleAlias -> ShowS
Prelude.Show, forall x. Rep UpdateRoleAlias x -> UpdateRoleAlias
forall x. UpdateRoleAlias -> Rep UpdateRoleAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRoleAlias x -> UpdateRoleAlias
$cfrom :: forall x. UpdateRoleAlias -> Rep UpdateRoleAlias x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRoleAlias' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'credentialDurationSeconds', 'updateRoleAlias_credentialDurationSeconds' - The number of seconds the credential will be valid.
--
-- This value must be less than or equal to the maximum session duration of
-- the IAM role that the role alias references.
--
-- 'roleArn', 'updateRoleAlias_roleArn' - The role ARN.
--
-- 'roleAlias', 'updateRoleAlias_roleAlias' - The role alias to update.
newUpdateRoleAlias ::
  -- | 'roleAlias'
  Prelude.Text ->
  UpdateRoleAlias
newUpdateRoleAlias :: Text -> UpdateRoleAlias
newUpdateRoleAlias Text
pRoleAlias_ =
  UpdateRoleAlias'
    { $sel:credentialDurationSeconds:UpdateRoleAlias' :: Maybe Natural
credentialDurationSeconds =
        forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:UpdateRoleAlias' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:roleAlias:UpdateRoleAlias' :: Text
roleAlias = Text
pRoleAlias_
    }

-- | The number of seconds the credential will be valid.
--
-- This value must be less than or equal to the maximum session duration of
-- the IAM role that the role alias references.
updateRoleAlias_credentialDurationSeconds :: Lens.Lens' UpdateRoleAlias (Prelude.Maybe Prelude.Natural)
updateRoleAlias_credentialDurationSeconds :: Lens' UpdateRoleAlias (Maybe Natural)
updateRoleAlias_credentialDurationSeconds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleAlias' {Maybe Natural
credentialDurationSeconds :: Maybe Natural
$sel:credentialDurationSeconds:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Natural
credentialDurationSeconds} -> Maybe Natural
credentialDurationSeconds) (\s :: UpdateRoleAlias
s@UpdateRoleAlias' {} Maybe Natural
a -> UpdateRoleAlias
s {$sel:credentialDurationSeconds:UpdateRoleAlias' :: Maybe Natural
credentialDurationSeconds = Maybe Natural
a} :: UpdateRoleAlias)

-- | The role ARN.
updateRoleAlias_roleArn :: Lens.Lens' UpdateRoleAlias (Prelude.Maybe Prelude.Text)
updateRoleAlias_roleArn :: Lens' UpdateRoleAlias (Maybe Text)
updateRoleAlias_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleAlias' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: UpdateRoleAlias
s@UpdateRoleAlias' {} Maybe Text
a -> UpdateRoleAlias
s {$sel:roleArn:UpdateRoleAlias' :: Maybe Text
roleArn = Maybe Text
a} :: UpdateRoleAlias)

-- | The role alias to update.
updateRoleAlias_roleAlias :: Lens.Lens' UpdateRoleAlias Prelude.Text
updateRoleAlias_roleAlias :: Lens' UpdateRoleAlias Text
updateRoleAlias_roleAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleAlias' {Text
roleAlias :: Text
$sel:roleAlias:UpdateRoleAlias' :: UpdateRoleAlias -> Text
roleAlias} -> Text
roleAlias) (\s :: UpdateRoleAlias
s@UpdateRoleAlias' {} Text
a -> UpdateRoleAlias
s {$sel:roleAlias:UpdateRoleAlias' :: Text
roleAlias = Text
a} :: UpdateRoleAlias)

instance Core.AWSRequest UpdateRoleAlias where
  type
    AWSResponse UpdateRoleAlias =
      UpdateRoleAliasResponse
  request :: (Service -> Service) -> UpdateRoleAlias -> Request UpdateRoleAlias
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateRoleAlias
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateRoleAlias)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Maybe Text -> Int -> UpdateRoleAliasResponse
UpdateRoleAliasResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"roleAlias")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"roleAliasArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateRoleAlias where
  hashWithSalt :: Int -> UpdateRoleAlias -> Int
hashWithSalt Int
_salt UpdateRoleAlias' {Maybe Natural
Maybe Text
Text
roleAlias :: Text
roleArn :: Maybe Text
credentialDurationSeconds :: Maybe Natural
$sel:roleAlias:UpdateRoleAlias' :: UpdateRoleAlias -> Text
$sel:roleArn:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Text
$sel:credentialDurationSeconds:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
credentialDurationSeconds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleAlias

instance Prelude.NFData UpdateRoleAlias where
  rnf :: UpdateRoleAlias -> ()
rnf UpdateRoleAlias' {Maybe Natural
Maybe Text
Text
roleAlias :: Text
roleArn :: Maybe Text
credentialDurationSeconds :: Maybe Natural
$sel:roleAlias:UpdateRoleAlias' :: UpdateRoleAlias -> Text
$sel:roleArn:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Text
$sel:credentialDurationSeconds:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
credentialDurationSeconds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleAlias

instance Data.ToHeaders UpdateRoleAlias where
  toHeaders :: UpdateRoleAlias -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON UpdateRoleAlias where
  toJSON :: UpdateRoleAlias -> Value
toJSON UpdateRoleAlias' {Maybe Natural
Maybe Text
Text
roleAlias :: Text
roleArn :: Maybe Text
credentialDurationSeconds :: Maybe Natural
$sel:roleAlias:UpdateRoleAlias' :: UpdateRoleAlias -> Text
$sel:roleArn:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Text
$sel:credentialDurationSeconds:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"credentialDurationSeconds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
credentialDurationSeconds,
            (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
roleArn
          ]
      )

instance Data.ToPath UpdateRoleAlias where
  toPath :: UpdateRoleAlias -> ByteString
toPath UpdateRoleAlias' {Maybe Natural
Maybe Text
Text
roleAlias :: Text
roleArn :: Maybe Text
credentialDurationSeconds :: Maybe Natural
$sel:roleAlias:UpdateRoleAlias' :: UpdateRoleAlias -> Text
$sel:roleArn:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Text
$sel:credentialDurationSeconds:UpdateRoleAlias' :: UpdateRoleAlias -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/role-aliases/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
roleAlias]

instance Data.ToQuery UpdateRoleAlias where
  toQuery :: UpdateRoleAlias -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateRoleAliasResponse' smart constructor.
data UpdateRoleAliasResponse = UpdateRoleAliasResponse'
  { -- | The role alias.
    UpdateRoleAliasResponse -> Maybe Text
roleAlias :: Prelude.Maybe Prelude.Text,
    -- | The role alias ARN.
    UpdateRoleAliasResponse -> Maybe Text
roleAliasArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateRoleAliasResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateRoleAliasResponse -> UpdateRoleAliasResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRoleAliasResponse -> UpdateRoleAliasResponse -> Bool
$c/= :: UpdateRoleAliasResponse -> UpdateRoleAliasResponse -> Bool
== :: UpdateRoleAliasResponse -> UpdateRoleAliasResponse -> Bool
$c== :: UpdateRoleAliasResponse -> UpdateRoleAliasResponse -> Bool
Prelude.Eq, ReadPrec [UpdateRoleAliasResponse]
ReadPrec UpdateRoleAliasResponse
Int -> ReadS UpdateRoleAliasResponse
ReadS [UpdateRoleAliasResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRoleAliasResponse]
$creadListPrec :: ReadPrec [UpdateRoleAliasResponse]
readPrec :: ReadPrec UpdateRoleAliasResponse
$creadPrec :: ReadPrec UpdateRoleAliasResponse
readList :: ReadS [UpdateRoleAliasResponse]
$creadList :: ReadS [UpdateRoleAliasResponse]
readsPrec :: Int -> ReadS UpdateRoleAliasResponse
$creadsPrec :: Int -> ReadS UpdateRoleAliasResponse
Prelude.Read, Int -> UpdateRoleAliasResponse -> ShowS
[UpdateRoleAliasResponse] -> ShowS
UpdateRoleAliasResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRoleAliasResponse] -> ShowS
$cshowList :: [UpdateRoleAliasResponse] -> ShowS
show :: UpdateRoleAliasResponse -> String
$cshow :: UpdateRoleAliasResponse -> String
showsPrec :: Int -> UpdateRoleAliasResponse -> ShowS
$cshowsPrec :: Int -> UpdateRoleAliasResponse -> ShowS
Prelude.Show, forall x. Rep UpdateRoleAliasResponse x -> UpdateRoleAliasResponse
forall x. UpdateRoleAliasResponse -> Rep UpdateRoleAliasResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRoleAliasResponse x -> UpdateRoleAliasResponse
$cfrom :: forall x. UpdateRoleAliasResponse -> Rep UpdateRoleAliasResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRoleAliasResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'roleAlias', 'updateRoleAliasResponse_roleAlias' - The role alias.
--
-- 'roleAliasArn', 'updateRoleAliasResponse_roleAliasArn' - The role alias ARN.
--
-- 'httpStatus', 'updateRoleAliasResponse_httpStatus' - The response's http status code.
newUpdateRoleAliasResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateRoleAliasResponse
newUpdateRoleAliasResponse :: Int -> UpdateRoleAliasResponse
newUpdateRoleAliasResponse Int
pHttpStatus_ =
  UpdateRoleAliasResponse'
    { $sel:roleAlias:UpdateRoleAliasResponse' :: Maybe Text
roleAlias =
        forall a. Maybe a
Prelude.Nothing,
      $sel:roleAliasArn:UpdateRoleAliasResponse' :: Maybe Text
roleAliasArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateRoleAliasResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The role alias.
updateRoleAliasResponse_roleAlias :: Lens.Lens' UpdateRoleAliasResponse (Prelude.Maybe Prelude.Text)
updateRoleAliasResponse_roleAlias :: Lens' UpdateRoleAliasResponse (Maybe Text)
updateRoleAliasResponse_roleAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleAliasResponse' {Maybe Text
roleAlias :: Maybe Text
$sel:roleAlias:UpdateRoleAliasResponse' :: UpdateRoleAliasResponse -> Maybe Text
roleAlias} -> Maybe Text
roleAlias) (\s :: UpdateRoleAliasResponse
s@UpdateRoleAliasResponse' {} Maybe Text
a -> UpdateRoleAliasResponse
s {$sel:roleAlias:UpdateRoleAliasResponse' :: Maybe Text
roleAlias = Maybe Text
a} :: UpdateRoleAliasResponse)

-- | The role alias ARN.
updateRoleAliasResponse_roleAliasArn :: Lens.Lens' UpdateRoleAliasResponse (Prelude.Maybe Prelude.Text)
updateRoleAliasResponse_roleAliasArn :: Lens' UpdateRoleAliasResponse (Maybe Text)
updateRoleAliasResponse_roleAliasArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleAliasResponse' {Maybe Text
roleAliasArn :: Maybe Text
$sel:roleAliasArn:UpdateRoleAliasResponse' :: UpdateRoleAliasResponse -> Maybe Text
roleAliasArn} -> Maybe Text
roleAliasArn) (\s :: UpdateRoleAliasResponse
s@UpdateRoleAliasResponse' {} Maybe Text
a -> UpdateRoleAliasResponse
s {$sel:roleAliasArn:UpdateRoleAliasResponse' :: Maybe Text
roleAliasArn = Maybe Text
a} :: UpdateRoleAliasResponse)

-- | The response's http status code.
updateRoleAliasResponse_httpStatus :: Lens.Lens' UpdateRoleAliasResponse Prelude.Int
updateRoleAliasResponse_httpStatus :: Lens' UpdateRoleAliasResponse Int
updateRoleAliasResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRoleAliasResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateRoleAliasResponse' :: UpdateRoleAliasResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateRoleAliasResponse
s@UpdateRoleAliasResponse' {} Int
a -> UpdateRoleAliasResponse
s {$sel:httpStatus:UpdateRoleAliasResponse' :: Int
httpStatus = Int
a} :: UpdateRoleAliasResponse)

instance Prelude.NFData UpdateRoleAliasResponse where
  rnf :: UpdateRoleAliasResponse -> ()
rnf UpdateRoleAliasResponse' {Int
Maybe Text
httpStatus :: Int
roleAliasArn :: Maybe Text
roleAlias :: Maybe Text
$sel:httpStatus:UpdateRoleAliasResponse' :: UpdateRoleAliasResponse -> Int
$sel:roleAliasArn:UpdateRoleAliasResponse' :: UpdateRoleAliasResponse -> Maybe Text
$sel:roleAlias:UpdateRoleAliasResponse' :: UpdateRoleAliasResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleAliasArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus