{-# 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.DeletePolicy
-- 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 managed policy.
--
-- Before you can delete a managed policy, you must first detach the policy
-- from all users, groups, and roles that it is attached to. In addition,
-- you must delete all the policy\'s versions. The following steps describe
-- the process for deleting a managed policy:
--
-- -   Detach the policy from all users, groups, and roles that the policy
--     is attached to, using DetachUserPolicy, DetachGroupPolicy, or
--     DetachRolePolicy. To list all the users, groups, and roles that a
--     policy is attached to, use ListEntitiesForPolicy.
--
-- -   Delete all versions of the policy using DeletePolicyVersion. To list
--     the policy\'s versions, use ListPolicyVersions. You cannot use
--     DeletePolicyVersion to delete the version that is marked as the
--     default version. You delete the policy\'s default version in the
--     next step of the process.
--
-- -   Delete the policy (this automatically deletes the policy\'s default
--     version) using this operation.
--
-- For information about managed policies, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/policies-managed-vs-inline.html Managed policies and inline policies>
-- in the /IAM User Guide/.
module Amazonka.IAM.DeletePolicy
  ( -- * Creating a Request
    DeletePolicy (..),
    newDeletePolicy,

    -- * Request Lenses
    deletePolicy_policyArn,

    -- * Destructuring the Response
    DeletePolicyResponse (..),
    newDeletePolicyResponse,
  )
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:/ 'newDeletePolicy' smart constructor.
data DeletePolicy = DeletePolicy'
  { -- | The Amazon Resource Name (ARN) of the IAM policy you want to delete.
    --
    -- For more information about ARNs, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
    -- in the /Amazon Web Services General Reference/.
    DeletePolicy -> Text
policyArn :: Prelude.Text
  }
  deriving (DeletePolicy -> DeletePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePolicy -> DeletePolicy -> Bool
$c/= :: DeletePolicy -> DeletePolicy -> Bool
== :: DeletePolicy -> DeletePolicy -> Bool
$c== :: DeletePolicy -> DeletePolicy -> Bool
Prelude.Eq, ReadPrec [DeletePolicy]
ReadPrec DeletePolicy
Int -> ReadS DeletePolicy
ReadS [DeletePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePolicy]
$creadListPrec :: ReadPrec [DeletePolicy]
readPrec :: ReadPrec DeletePolicy
$creadPrec :: ReadPrec DeletePolicy
readList :: ReadS [DeletePolicy]
$creadList :: ReadS [DeletePolicy]
readsPrec :: Int -> ReadS DeletePolicy
$creadsPrec :: Int -> ReadS DeletePolicy
Prelude.Read, Int -> DeletePolicy -> ShowS
[DeletePolicy] -> ShowS
DeletePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePolicy] -> ShowS
$cshowList :: [DeletePolicy] -> ShowS
show :: DeletePolicy -> String
$cshow :: DeletePolicy -> String
showsPrec :: Int -> DeletePolicy -> ShowS
$cshowsPrec :: Int -> DeletePolicy -> ShowS
Prelude.Show, forall x. Rep DeletePolicy x -> DeletePolicy
forall x. DeletePolicy -> Rep DeletePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeletePolicy x -> DeletePolicy
$cfrom :: forall x. DeletePolicy -> Rep DeletePolicy x
Prelude.Generic)

-- |
-- Create a value of 'DeletePolicy' 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:
--
-- 'policyArn', 'deletePolicy_policyArn' - The Amazon Resource Name (ARN) of the IAM policy you want to delete.
--
-- For more information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/.
newDeletePolicy ::
  -- | 'policyArn'
  Prelude.Text ->
  DeletePolicy
newDeletePolicy :: Text -> DeletePolicy
newDeletePolicy Text
pPolicyArn_ =
  DeletePolicy' {$sel:policyArn:DeletePolicy' :: Text
policyArn = Text
pPolicyArn_}

-- | The Amazon Resource Name (ARN) of the IAM policy you want to delete.
--
-- For more information about ARNs, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html Amazon Resource Names (ARNs)>
-- in the /Amazon Web Services General Reference/.
deletePolicy_policyArn :: Lens.Lens' DeletePolicy Prelude.Text
deletePolicy_policyArn :: Lens' DeletePolicy Text
deletePolicy_policyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePolicy' {Text
policyArn :: Text
$sel:policyArn:DeletePolicy' :: DeletePolicy -> Text
policyArn} -> Text
policyArn) (\s :: DeletePolicy
s@DeletePolicy' {} Text
a -> DeletePolicy
s {$sel:policyArn:DeletePolicy' :: Text
policyArn = Text
a} :: DeletePolicy)

instance Core.AWSRequest DeletePolicy where
  type AWSResponse DeletePolicy = DeletePolicyResponse
  request :: (Service -> Service) -> DeletePolicy -> Request DeletePolicy
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 DeletePolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeletePolicy)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeletePolicyResponse
DeletePolicyResponse'

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

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

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

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

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

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

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

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