{-# 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.IAM.DeleteRole
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified role. The role must not have any policies
-- attached. For more information about roles, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/WorkingWithRoles.html Working with roles>.
--
-- Make sure that you do not have any Amazon EC2 instances running with the
-- role you are about to delete. Deleting a role or instance profile that
-- is associated with a running instance will break any applications
-- running on the instance.
module Amazonka.IAM.DeleteRole
  ( -- * Creating a Request
    DeleteRole (..),
    newDeleteRole,

    -- * Request Lenses
    deleteRole_roleName,

    -- * Destructuring the Response
    DeleteRoleResponse (..),
    newDeleteRoleResponse,
  )
where

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

-- | /See:/ 'newDeleteRole' smart constructor.
data DeleteRole = DeleteRole'
  { -- | The name of the role to delete.
    --
    -- This parameter allows (through its
    -- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
    -- consisting of upper and lowercase alphanumeric characters with no
    -- spaces. You can also include any of the following characters: _+=,.\@-
    DeleteRole -> Text
roleName :: Prelude.Text
  }
  deriving (DeleteRole -> DeleteRole -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteRole -> DeleteRole -> Bool
$c/= :: DeleteRole -> DeleteRole -> Bool
== :: DeleteRole -> DeleteRole -> Bool
$c== :: DeleteRole -> DeleteRole -> Bool
Prelude.Eq, ReadPrec [DeleteRole]
ReadPrec DeleteRole
Int -> ReadS DeleteRole
ReadS [DeleteRole]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteRole]
$creadListPrec :: ReadPrec [DeleteRole]
readPrec :: ReadPrec DeleteRole
$creadPrec :: ReadPrec DeleteRole
readList :: ReadS [DeleteRole]
$creadList :: ReadS [DeleteRole]
readsPrec :: Int -> ReadS DeleteRole
$creadsPrec :: Int -> ReadS DeleteRole
Prelude.Read, Int -> DeleteRole -> ShowS
[DeleteRole] -> ShowS
DeleteRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteRole] -> ShowS
$cshowList :: [DeleteRole] -> ShowS
show :: DeleteRole -> String
$cshow :: DeleteRole -> String
showsPrec :: Int -> DeleteRole -> ShowS
$cshowsPrec :: Int -> DeleteRole -> ShowS
Prelude.Show, forall x. Rep DeleteRole x -> DeleteRole
forall x. DeleteRole -> Rep DeleteRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteRole x -> DeleteRole
$cfrom :: forall x. DeleteRole -> Rep DeleteRole x
Prelude.Generic)

-- |
-- Create a value of 'DeleteRole' 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:
--
-- 'roleName', 'deleteRole_roleName' - The name of the role to delete.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
newDeleteRole ::
  -- | 'roleName'
  Prelude.Text ->
  DeleteRole
newDeleteRole :: Text -> DeleteRole
newDeleteRole Text
pRoleName_ =
  DeleteRole' {$sel:roleName:DeleteRole' :: Text
roleName = Text
pRoleName_}

-- | The name of the role to delete.
--
-- This parameter allows (through its
-- <http://wikipedia.org/wiki/regex regex pattern>) a string of characters
-- consisting of upper and lowercase alphanumeric characters with no
-- spaces. You can also include any of the following characters: _+=,.\@-
deleteRole_roleName :: Lens.Lens' DeleteRole Prelude.Text
deleteRole_roleName :: Lens' DeleteRole Text
deleteRole_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteRole' {Text
roleName :: Text
$sel:roleName:DeleteRole' :: DeleteRole -> Text
roleName} -> Text
roleName) (\s :: DeleteRole
s@DeleteRole' {} Text
a -> DeleteRole
s {$sel:roleName:DeleteRole' :: Text
roleName = Text
a} :: DeleteRole)

instance Core.AWSRequest DeleteRole where
  type AWSResponse DeleteRole = DeleteRoleResponse
  request :: (Service -> Service) -> DeleteRole -> Request DeleteRole
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteRole
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteRole)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteRoleResponse
DeleteRoleResponse'

instance Prelude.Hashable DeleteRole where
  hashWithSalt :: Int -> DeleteRole -> Int
hashWithSalt Int
_salt DeleteRole' {Text
roleName :: Text
$sel:roleName:DeleteRole' :: DeleteRole -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleName

instance Prelude.NFData DeleteRole where
  rnf :: DeleteRole -> ()
rnf DeleteRole' {Text
roleName :: Text
$sel:roleName:DeleteRole' :: DeleteRole -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
roleName

instance Data.ToHeaders DeleteRole where
  toHeaders :: DeleteRole -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DeleteRole where
  toPath :: DeleteRole -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery DeleteRole where
  toQuery :: DeleteRole -> QueryString
toQuery DeleteRole' {Text
roleName :: Text
$sel:roleName:DeleteRole' :: DeleteRole -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteRole" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"RoleName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
roleName
      ]

-- | /See:/ 'newDeleteRoleResponse' smart constructor.
data DeleteRoleResponse = DeleteRoleResponse'
  {
  }
  deriving (DeleteRoleResponse -> DeleteRoleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteRoleResponse -> DeleteRoleResponse -> Bool
$c/= :: DeleteRoleResponse -> DeleteRoleResponse -> Bool
== :: DeleteRoleResponse -> DeleteRoleResponse -> Bool
$c== :: DeleteRoleResponse -> DeleteRoleResponse -> Bool
Prelude.Eq, ReadPrec [DeleteRoleResponse]
ReadPrec DeleteRoleResponse
Int -> ReadS DeleteRoleResponse
ReadS [DeleteRoleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteRoleResponse]
$creadListPrec :: ReadPrec [DeleteRoleResponse]
readPrec :: ReadPrec DeleteRoleResponse
$creadPrec :: ReadPrec DeleteRoleResponse
readList :: ReadS [DeleteRoleResponse]
$creadList :: ReadS [DeleteRoleResponse]
readsPrec :: Int -> ReadS DeleteRoleResponse
$creadsPrec :: Int -> ReadS DeleteRoleResponse
Prelude.Read, Int -> DeleteRoleResponse -> ShowS
[DeleteRoleResponse] -> ShowS
DeleteRoleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteRoleResponse] -> ShowS
$cshowList :: [DeleteRoleResponse] -> ShowS
show :: DeleteRoleResponse -> String
$cshow :: DeleteRoleResponse -> String
showsPrec :: Int -> DeleteRoleResponse -> ShowS
$cshowsPrec :: Int -> DeleteRoleResponse -> ShowS
Prelude.Show, forall x. Rep DeleteRoleResponse x -> DeleteRoleResponse
forall x. DeleteRoleResponse -> Rep DeleteRoleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteRoleResponse x -> DeleteRoleResponse
$cfrom :: forall x. DeleteRoleResponse -> Rep DeleteRoleResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteRoleResponse' 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.
newDeleteRoleResponse ::
  DeleteRoleResponse
newDeleteRoleResponse :: DeleteRoleResponse
newDeleteRoleResponse = DeleteRoleResponse
DeleteRoleResponse'

instance Prelude.NFData DeleteRoleResponse where
  rnf :: DeleteRoleResponse -> ()
rnf DeleteRoleResponse
_ = ()