{-# 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.Synthetics.DeleteCanary
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Permanently deletes the specified canary.
--
-- If you specify @DeleteLambda@ to @true@, CloudWatch Synthetics also
-- deletes the Lambda functions and layers that are used by the canary.
--
-- Other resources used and created by the canary are not automatically
-- deleted. After you delete a canary that you do not intend to use again,
-- you should also delete the following:
--
-- -   The CloudWatch alarms created for this canary. These alarms have a
--     name of @Synthetics-SharpDrop-Alarm-@/@MyCanaryName@/@ @.
--
-- -   Amazon S3 objects and buckets, such as the canary\'s artifact
--     location.
--
-- -   IAM roles created for the canary. If they were created in the
--     console, these roles have the name
--     @ role\/service-role\/CloudWatchSyntheticsRole-@/@MyCanaryName@/@ @.
--
-- -   CloudWatch Logs log groups created for the canary. These logs groups
--     have the name @\/aws\/lambda\/cwsyn-@/@MyCanaryName@/@ @.
--
-- Before you delete a canary, you might want to use @GetCanary@ to display
-- the information about this canary. Make note of the information returned
-- by this operation so that you can delete these resources after you
-- delete the canary.
module Amazonka.Synthetics.DeleteCanary
  ( -- * Creating a Request
    DeleteCanary (..),
    newDeleteCanary,

    -- * Request Lenses
    deleteCanary_deleteLambda,
    deleteCanary_name,

    -- * Destructuring the Response
    DeleteCanaryResponse (..),
    newDeleteCanaryResponse,

    -- * Response Lenses
    deleteCanaryResponse_httpStatus,
  )
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 qualified Amazonka.Response as Response
import Amazonka.Synthetics.Types

-- | /See:/ 'newDeleteCanary' smart constructor.
data DeleteCanary = DeleteCanary'
  { -- | Specifies whether to also delete the Lambda functions and layers used by
    -- this canary. The default is false.
    --
    -- Type: Boolean
    DeleteCanary -> Maybe Bool
deleteLambda :: Prelude.Maybe Prelude.Bool,
    -- | The name of the canary that you want to delete. To find the names of
    -- your canaries, use
    -- <https://docs.aws.amazon.com/AmazonSynthetics/latest/APIReference/API_DescribeCanaries.html DescribeCanaries>.
    DeleteCanary -> Text
name :: Prelude.Text
  }
  deriving (DeleteCanary -> DeleteCanary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteCanary -> DeleteCanary -> Bool
$c/= :: DeleteCanary -> DeleteCanary -> Bool
== :: DeleteCanary -> DeleteCanary -> Bool
$c== :: DeleteCanary -> DeleteCanary -> Bool
Prelude.Eq, ReadPrec [DeleteCanary]
ReadPrec DeleteCanary
Int -> ReadS DeleteCanary
ReadS [DeleteCanary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteCanary]
$creadListPrec :: ReadPrec [DeleteCanary]
readPrec :: ReadPrec DeleteCanary
$creadPrec :: ReadPrec DeleteCanary
readList :: ReadS [DeleteCanary]
$creadList :: ReadS [DeleteCanary]
readsPrec :: Int -> ReadS DeleteCanary
$creadsPrec :: Int -> ReadS DeleteCanary
Prelude.Read, Int -> DeleteCanary -> ShowS
[DeleteCanary] -> ShowS
DeleteCanary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteCanary] -> ShowS
$cshowList :: [DeleteCanary] -> ShowS
show :: DeleteCanary -> String
$cshow :: DeleteCanary -> String
showsPrec :: Int -> DeleteCanary -> ShowS
$cshowsPrec :: Int -> DeleteCanary -> ShowS
Prelude.Show, forall x. Rep DeleteCanary x -> DeleteCanary
forall x. DeleteCanary -> Rep DeleteCanary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteCanary x -> DeleteCanary
$cfrom :: forall x. DeleteCanary -> Rep DeleteCanary x
Prelude.Generic)

-- |
-- Create a value of 'DeleteCanary' 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:
--
-- 'deleteLambda', 'deleteCanary_deleteLambda' - Specifies whether to also delete the Lambda functions and layers used by
-- this canary. The default is false.
--
-- Type: Boolean
--
-- 'name', 'deleteCanary_name' - The name of the canary that you want to delete. To find the names of
-- your canaries, use
-- <https://docs.aws.amazon.com/AmazonSynthetics/latest/APIReference/API_DescribeCanaries.html DescribeCanaries>.
newDeleteCanary ::
  -- | 'name'
  Prelude.Text ->
  DeleteCanary
newDeleteCanary :: Text -> DeleteCanary
newDeleteCanary Text
pName_ =
  DeleteCanary'
    { $sel:deleteLambda:DeleteCanary' :: Maybe Bool
deleteLambda = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DeleteCanary' :: Text
name = Text
pName_
    }

-- | Specifies whether to also delete the Lambda functions and layers used by
-- this canary. The default is false.
--
-- Type: Boolean
deleteCanary_deleteLambda :: Lens.Lens' DeleteCanary (Prelude.Maybe Prelude.Bool)
deleteCanary_deleteLambda :: Lens' DeleteCanary (Maybe Bool)
deleteCanary_deleteLambda = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCanary' {Maybe Bool
deleteLambda :: Maybe Bool
$sel:deleteLambda:DeleteCanary' :: DeleteCanary -> Maybe Bool
deleteLambda} -> Maybe Bool
deleteLambda) (\s :: DeleteCanary
s@DeleteCanary' {} Maybe Bool
a -> DeleteCanary
s {$sel:deleteLambda:DeleteCanary' :: Maybe Bool
deleteLambda = Maybe Bool
a} :: DeleteCanary)

-- | The name of the canary that you want to delete. To find the names of
-- your canaries, use
-- <https://docs.aws.amazon.com/AmazonSynthetics/latest/APIReference/API_DescribeCanaries.html DescribeCanaries>.
deleteCanary_name :: Lens.Lens' DeleteCanary Prelude.Text
deleteCanary_name :: Lens' DeleteCanary Text
deleteCanary_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteCanary' {Text
name :: Text
$sel:name:DeleteCanary' :: DeleteCanary -> Text
name} -> Text
name) (\s :: DeleteCanary
s@DeleteCanary' {} Text
a -> DeleteCanary
s {$sel:name:DeleteCanary' :: Text
name = Text
a} :: DeleteCanary)

instance Core.AWSRequest DeleteCanary where
  type AWSResponse DeleteCanary = DeleteCanaryResponse
  request :: (Service -> Service) -> DeleteCanary -> Request DeleteCanary
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteCanary
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteCanary)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteCanaryResponse
DeleteCanaryResponse'
            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))
      )

instance Prelude.Hashable DeleteCanary where
  hashWithSalt :: Int -> DeleteCanary -> Int
hashWithSalt Int
_salt DeleteCanary' {Maybe Bool
Text
name :: Text
deleteLambda :: Maybe Bool
$sel:name:DeleteCanary' :: DeleteCanary -> Text
$sel:deleteLambda:DeleteCanary' :: DeleteCanary -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
deleteLambda
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData DeleteCanary where
  rnf :: DeleteCanary -> ()
rnf DeleteCanary' {Maybe Bool
Text
name :: Text
deleteLambda :: Maybe Bool
$sel:name:DeleteCanary' :: DeleteCanary -> Text
$sel:deleteLambda:DeleteCanary' :: DeleteCanary -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
deleteLambda
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders DeleteCanary where
  toHeaders :: DeleteCanary -> 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.ToPath DeleteCanary where
  toPath :: DeleteCanary -> ByteString
toPath DeleteCanary' {Maybe Bool
Text
name :: Text
deleteLambda :: Maybe Bool
$sel:name:DeleteCanary' :: DeleteCanary -> Text
$sel:deleteLambda:DeleteCanary' :: DeleteCanary -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/canary/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

instance Data.ToQuery DeleteCanary where
  toQuery :: DeleteCanary -> QueryString
toQuery DeleteCanary' {Maybe Bool
Text
name :: Text
deleteLambda :: Maybe Bool
$sel:name:DeleteCanary' :: DeleteCanary -> Text
$sel:deleteLambda:DeleteCanary' :: DeleteCanary -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"deleteLambda" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
deleteLambda]

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

-- |
-- Create a value of 'DeleteCanaryResponse' 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', 'deleteCanaryResponse_httpStatus' - The response's http status code.
newDeleteCanaryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteCanaryResponse
newDeleteCanaryResponse :: Int -> DeleteCanaryResponse
newDeleteCanaryResponse Int
pHttpStatus_ =
  DeleteCanaryResponse' {$sel:httpStatus:DeleteCanaryResponse' :: Int
httpStatus = Int
pHttpStatus_}

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

instance Prelude.NFData DeleteCanaryResponse where
  rnf :: DeleteCanaryResponse -> ()
rnf DeleteCanaryResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteCanaryResponse' :: DeleteCanaryResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus