{-# 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.ResilienceHub.DeleteResiliencyPolicy
-- 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 a resiliency policy. This is a destructive action that can\'t be
-- undone.
module Amazonka.ResilienceHub.DeleteResiliencyPolicy
  ( -- * Creating a Request
    DeleteResiliencyPolicy (..),
    newDeleteResiliencyPolicy,

    -- * Request Lenses
    deleteResiliencyPolicy_clientToken,
    deleteResiliencyPolicy_policyArn,

    -- * Destructuring the Response
    DeleteResiliencyPolicyResponse (..),
    newDeleteResiliencyPolicyResponse,

    -- * Response Lenses
    deleteResiliencyPolicyResponse_httpStatus,
    deleteResiliencyPolicyResponse_policyArn,
  )
where

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

-- | /See:/ 'newDeleteResiliencyPolicy' smart constructor.
data DeleteResiliencyPolicy = DeleteResiliencyPolicy'
  { -- | Used for an idempotency token. A client token is a unique,
    -- case-sensitive string of up to 64 ASCII characters. You should not reuse
    -- the same client token for other API requests.
    DeleteResiliencyPolicy -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the resiliency policy. The format for
    -- this ARN is:
    -- arn:@partition@:resiliencehub:@region@:@account@:resiliency-policy\/@policy-id@.
    -- 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 /AWS General Reference/.
    DeleteResiliencyPolicy -> Text
policyArn :: Prelude.Text
  }
  deriving (DeleteResiliencyPolicy -> DeleteResiliencyPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteResiliencyPolicy -> DeleteResiliencyPolicy -> Bool
$c/= :: DeleteResiliencyPolicy -> DeleteResiliencyPolicy -> Bool
== :: DeleteResiliencyPolicy -> DeleteResiliencyPolicy -> Bool
$c== :: DeleteResiliencyPolicy -> DeleteResiliencyPolicy -> Bool
Prelude.Eq, ReadPrec [DeleteResiliencyPolicy]
ReadPrec DeleteResiliencyPolicy
Int -> ReadS DeleteResiliencyPolicy
ReadS [DeleteResiliencyPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteResiliencyPolicy]
$creadListPrec :: ReadPrec [DeleteResiliencyPolicy]
readPrec :: ReadPrec DeleteResiliencyPolicy
$creadPrec :: ReadPrec DeleteResiliencyPolicy
readList :: ReadS [DeleteResiliencyPolicy]
$creadList :: ReadS [DeleteResiliencyPolicy]
readsPrec :: Int -> ReadS DeleteResiliencyPolicy
$creadsPrec :: Int -> ReadS DeleteResiliencyPolicy
Prelude.Read, Int -> DeleteResiliencyPolicy -> ShowS
[DeleteResiliencyPolicy] -> ShowS
DeleteResiliencyPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteResiliencyPolicy] -> ShowS
$cshowList :: [DeleteResiliencyPolicy] -> ShowS
show :: DeleteResiliencyPolicy -> String
$cshow :: DeleteResiliencyPolicy -> String
showsPrec :: Int -> DeleteResiliencyPolicy -> ShowS
$cshowsPrec :: Int -> DeleteResiliencyPolicy -> ShowS
Prelude.Show, forall x. Rep DeleteResiliencyPolicy x -> DeleteResiliencyPolicy
forall x. DeleteResiliencyPolicy -> Rep DeleteResiliencyPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteResiliencyPolicy x -> DeleteResiliencyPolicy
$cfrom :: forall x. DeleteResiliencyPolicy -> Rep DeleteResiliencyPolicy x
Prelude.Generic)

-- |
-- Create a value of 'DeleteResiliencyPolicy' 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:
--
-- 'clientToken', 'deleteResiliencyPolicy_clientToken' - Used for an idempotency token. A client token is a unique,
-- case-sensitive string of up to 64 ASCII characters. You should not reuse
-- the same client token for other API requests.
--
-- 'policyArn', 'deleteResiliencyPolicy_policyArn' - The Amazon Resource Name (ARN) of the resiliency policy. The format for
-- this ARN is:
-- arn:@partition@:resiliencehub:@region@:@account@:resiliency-policy\/@policy-id@.
-- 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 /AWS General Reference/.
newDeleteResiliencyPolicy ::
  -- | 'policyArn'
  Prelude.Text ->
  DeleteResiliencyPolicy
newDeleteResiliencyPolicy :: Text -> DeleteResiliencyPolicy
newDeleteResiliencyPolicy Text
pPolicyArn_ =
  DeleteResiliencyPolicy'
    { $sel:clientToken:DeleteResiliencyPolicy' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:policyArn:DeleteResiliencyPolicy' :: Text
policyArn = Text
pPolicyArn_
    }

-- | Used for an idempotency token. A client token is a unique,
-- case-sensitive string of up to 64 ASCII characters. You should not reuse
-- the same client token for other API requests.
deleteResiliencyPolicy_clientToken :: Lens.Lens' DeleteResiliencyPolicy (Prelude.Maybe Prelude.Text)
deleteResiliencyPolicy_clientToken :: Lens' DeleteResiliencyPolicy (Maybe Text)
deleteResiliencyPolicy_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteResiliencyPolicy' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:DeleteResiliencyPolicy' :: DeleteResiliencyPolicy -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: DeleteResiliencyPolicy
s@DeleteResiliencyPolicy' {} Maybe Text
a -> DeleteResiliencyPolicy
s {$sel:clientToken:DeleteResiliencyPolicy' :: Maybe Text
clientToken = Maybe Text
a} :: DeleteResiliencyPolicy)

-- | The Amazon Resource Name (ARN) of the resiliency policy. The format for
-- this ARN is:
-- arn:@partition@:resiliencehub:@region@:@account@:resiliency-policy\/@policy-id@.
-- 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 /AWS General Reference/.
deleteResiliencyPolicy_policyArn :: Lens.Lens' DeleteResiliencyPolicy Prelude.Text
deleteResiliencyPolicy_policyArn :: Lens' DeleteResiliencyPolicy Text
deleteResiliencyPolicy_policyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteResiliencyPolicy' {Text
policyArn :: Text
$sel:policyArn:DeleteResiliencyPolicy' :: DeleteResiliencyPolicy -> Text
policyArn} -> Text
policyArn) (\s :: DeleteResiliencyPolicy
s@DeleteResiliencyPolicy' {} Text
a -> DeleteResiliencyPolicy
s {$sel:policyArn:DeleteResiliencyPolicy' :: Text
policyArn = Text
a} :: DeleteResiliencyPolicy)

instance Core.AWSRequest DeleteResiliencyPolicy where
  type
    AWSResponse DeleteResiliencyPolicy =
      DeleteResiliencyPolicyResponse
  request :: (Service -> Service)
-> DeleteResiliencyPolicy -> Request DeleteResiliencyPolicy
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteResiliencyPolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteResiliencyPolicy)))
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 ->
          Int -> Text -> DeleteResiliencyPolicyResponse
DeleteResiliencyPolicyResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"policyArn")
      )

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

instance Prelude.NFData DeleteResiliencyPolicy where
  rnf :: DeleteResiliencyPolicy -> ()
rnf DeleteResiliencyPolicy' {Maybe Text
Text
policyArn :: Text
clientToken :: Maybe Text
$sel:policyArn:DeleteResiliencyPolicy' :: DeleteResiliencyPolicy -> Text
$sel:clientToken:DeleteResiliencyPolicy' :: DeleteResiliencyPolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policyArn

instance Data.ToHeaders DeleteResiliencyPolicy where
  toHeaders :: DeleteResiliencyPolicy -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteResiliencyPolicy where
  toJSON :: DeleteResiliencyPolicy -> Value
toJSON DeleteResiliencyPolicy' {Maybe Text
Text
policyArn :: Text
clientToken :: Maybe Text
$sel:policyArn:DeleteResiliencyPolicy' :: DeleteResiliencyPolicy -> Text
$sel:clientToken:DeleteResiliencyPolicy' :: DeleteResiliencyPolicy -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"clientToken" 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
clientToken,
            forall a. a -> Maybe a
Prelude.Just (Key
"policyArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
policyArn)
          ]
      )

instance Data.ToPath DeleteResiliencyPolicy where
  toPath :: DeleteResiliencyPolicy -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/delete-resiliency-policy"

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

-- | /See:/ 'newDeleteResiliencyPolicyResponse' smart constructor.
data DeleteResiliencyPolicyResponse = DeleteResiliencyPolicyResponse'
  { -- | The response's http status code.
    DeleteResiliencyPolicyResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the resiliency policy. The format for
    -- this ARN is:
    -- arn:@partition@:resiliencehub:@region@:@account@:resiliency-policy\/@policy-id@.
    -- 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 /AWS General Reference/.
    DeleteResiliencyPolicyResponse -> Text
policyArn :: Prelude.Text
  }
  deriving (DeleteResiliencyPolicyResponse
-> DeleteResiliencyPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteResiliencyPolicyResponse
-> DeleteResiliencyPolicyResponse -> Bool
$c/= :: DeleteResiliencyPolicyResponse
-> DeleteResiliencyPolicyResponse -> Bool
== :: DeleteResiliencyPolicyResponse
-> DeleteResiliencyPolicyResponse -> Bool
$c== :: DeleteResiliencyPolicyResponse
-> DeleteResiliencyPolicyResponse -> Bool
Prelude.Eq, ReadPrec [DeleteResiliencyPolicyResponse]
ReadPrec DeleteResiliencyPolicyResponse
Int -> ReadS DeleteResiliencyPolicyResponse
ReadS [DeleteResiliencyPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteResiliencyPolicyResponse]
$creadListPrec :: ReadPrec [DeleteResiliencyPolicyResponse]
readPrec :: ReadPrec DeleteResiliencyPolicyResponse
$creadPrec :: ReadPrec DeleteResiliencyPolicyResponse
readList :: ReadS [DeleteResiliencyPolicyResponse]
$creadList :: ReadS [DeleteResiliencyPolicyResponse]
readsPrec :: Int -> ReadS DeleteResiliencyPolicyResponse
$creadsPrec :: Int -> ReadS DeleteResiliencyPolicyResponse
Prelude.Read, Int -> DeleteResiliencyPolicyResponse -> ShowS
[DeleteResiliencyPolicyResponse] -> ShowS
DeleteResiliencyPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteResiliencyPolicyResponse] -> ShowS
$cshowList :: [DeleteResiliencyPolicyResponse] -> ShowS
show :: DeleteResiliencyPolicyResponse -> String
$cshow :: DeleteResiliencyPolicyResponse -> String
showsPrec :: Int -> DeleteResiliencyPolicyResponse -> ShowS
$cshowsPrec :: Int -> DeleteResiliencyPolicyResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteResiliencyPolicyResponse x
-> DeleteResiliencyPolicyResponse
forall x.
DeleteResiliencyPolicyResponse
-> Rep DeleteResiliencyPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteResiliencyPolicyResponse x
-> DeleteResiliencyPolicyResponse
$cfrom :: forall x.
DeleteResiliencyPolicyResponse
-> Rep DeleteResiliencyPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteResiliencyPolicyResponse' 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:
--
-- 'httpStatus', 'deleteResiliencyPolicyResponse_httpStatus' - The response's http status code.
--
-- 'policyArn', 'deleteResiliencyPolicyResponse_policyArn' - The Amazon Resource Name (ARN) of the resiliency policy. The format for
-- this ARN is:
-- arn:@partition@:resiliencehub:@region@:@account@:resiliency-policy\/@policy-id@.
-- 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 /AWS General Reference/.
newDeleteResiliencyPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'policyArn'
  Prelude.Text ->
  DeleteResiliencyPolicyResponse
newDeleteResiliencyPolicyResponse :: Int -> Text -> DeleteResiliencyPolicyResponse
newDeleteResiliencyPolicyResponse
  Int
pHttpStatus_
  Text
pPolicyArn_ =
    DeleteResiliencyPolicyResponse'
      { $sel:httpStatus:DeleteResiliencyPolicyResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:policyArn:DeleteResiliencyPolicyResponse' :: Text
policyArn = Text
pPolicyArn_
      }

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

-- | The Amazon Resource Name (ARN) of the resiliency policy. The format for
-- this ARN is:
-- arn:@partition@:resiliencehub:@region@:@account@:resiliency-policy\/@policy-id@.
-- 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 /AWS General Reference/.
deleteResiliencyPolicyResponse_policyArn :: Lens.Lens' DeleteResiliencyPolicyResponse Prelude.Text
deleteResiliencyPolicyResponse_policyArn :: Lens' DeleteResiliencyPolicyResponse Text
deleteResiliencyPolicyResponse_policyArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteResiliencyPolicyResponse' {Text
policyArn :: Text
$sel:policyArn:DeleteResiliencyPolicyResponse' :: DeleteResiliencyPolicyResponse -> Text
policyArn} -> Text
policyArn) (\s :: DeleteResiliencyPolicyResponse
s@DeleteResiliencyPolicyResponse' {} Text
a -> DeleteResiliencyPolicyResponse
s {$sel:policyArn:DeleteResiliencyPolicyResponse' :: Text
policyArn = Text
a} :: DeleteResiliencyPolicyResponse)

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