{-# 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.Route53.DeleteHealthCheck
-- 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 health check.
--
-- Amazon Route 53 does not prevent you from deleting a health check even
-- if the health check is associated with one or more resource record sets.
-- If you delete a health check and you don\'t update the associated
-- resource record sets, the future status of the health check can\'t be
-- predicted and may change. This will affect the routing of DNS queries
-- for your DNS failover configuration. For more information, see
-- <https://docs.aws.amazon.com/Route53/latest/DeveloperGuide/health-checks-creating-deleting.html#health-checks-deleting.html Replacing and Deleting Health Checks>
-- in the /Amazon Route 53 Developer Guide/.
--
-- If you\'re using Cloud Map and you configured Cloud Map to create a
-- Route 53 health check when you register an instance, you can\'t use the
-- Route 53 @DeleteHealthCheck@ command to delete the health check. The
-- health check is deleted automatically when you deregister the instance;
-- there can be a delay of several hours before the health check is deleted
-- from Route 53.
module Amazonka.Route53.DeleteHealthCheck
  ( -- * Creating a Request
    DeleteHealthCheck (..),
    newDeleteHealthCheck,

    -- * Request Lenses
    deleteHealthCheck_healthCheckId,

    -- * Destructuring the Response
    DeleteHealthCheckResponse (..),
    newDeleteHealthCheckResponse,

    -- * Response Lenses
    deleteHealthCheckResponse_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.Route53.Types

-- | This action deletes a health check.
--
-- /See:/ 'newDeleteHealthCheck' smart constructor.
data DeleteHealthCheck = DeleteHealthCheck'
  { -- | The ID of the health check that you want to delete.
    DeleteHealthCheck -> Text
healthCheckId :: Prelude.Text
  }
  deriving (DeleteHealthCheck -> DeleteHealthCheck -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteHealthCheck -> DeleteHealthCheck -> Bool
$c/= :: DeleteHealthCheck -> DeleteHealthCheck -> Bool
== :: DeleteHealthCheck -> DeleteHealthCheck -> Bool
$c== :: DeleteHealthCheck -> DeleteHealthCheck -> Bool
Prelude.Eq, ReadPrec [DeleteHealthCheck]
ReadPrec DeleteHealthCheck
Int -> ReadS DeleteHealthCheck
ReadS [DeleteHealthCheck]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteHealthCheck]
$creadListPrec :: ReadPrec [DeleteHealthCheck]
readPrec :: ReadPrec DeleteHealthCheck
$creadPrec :: ReadPrec DeleteHealthCheck
readList :: ReadS [DeleteHealthCheck]
$creadList :: ReadS [DeleteHealthCheck]
readsPrec :: Int -> ReadS DeleteHealthCheck
$creadsPrec :: Int -> ReadS DeleteHealthCheck
Prelude.Read, Int -> DeleteHealthCheck -> ShowS
[DeleteHealthCheck] -> ShowS
DeleteHealthCheck -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteHealthCheck] -> ShowS
$cshowList :: [DeleteHealthCheck] -> ShowS
show :: DeleteHealthCheck -> String
$cshow :: DeleteHealthCheck -> String
showsPrec :: Int -> DeleteHealthCheck -> ShowS
$cshowsPrec :: Int -> DeleteHealthCheck -> ShowS
Prelude.Show, forall x. Rep DeleteHealthCheck x -> DeleteHealthCheck
forall x. DeleteHealthCheck -> Rep DeleteHealthCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteHealthCheck x -> DeleteHealthCheck
$cfrom :: forall x. DeleteHealthCheck -> Rep DeleteHealthCheck x
Prelude.Generic)

-- |
-- Create a value of 'DeleteHealthCheck' 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:
--
-- 'healthCheckId', 'deleteHealthCheck_healthCheckId' - The ID of the health check that you want to delete.
newDeleteHealthCheck ::
  -- | 'healthCheckId'
  Prelude.Text ->
  DeleteHealthCheck
newDeleteHealthCheck :: Text -> DeleteHealthCheck
newDeleteHealthCheck Text
pHealthCheckId_ =
  DeleteHealthCheck' {$sel:healthCheckId:DeleteHealthCheck' :: Text
healthCheckId = Text
pHealthCheckId_}

-- | The ID of the health check that you want to delete.
deleteHealthCheck_healthCheckId :: Lens.Lens' DeleteHealthCheck Prelude.Text
deleteHealthCheck_healthCheckId :: Lens' DeleteHealthCheck Text
deleteHealthCheck_healthCheckId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteHealthCheck' {Text
healthCheckId :: Text
$sel:healthCheckId:DeleteHealthCheck' :: DeleteHealthCheck -> Text
healthCheckId} -> Text
healthCheckId) (\s :: DeleteHealthCheck
s@DeleteHealthCheck' {} Text
a -> DeleteHealthCheck
s {$sel:healthCheckId:DeleteHealthCheck' :: Text
healthCheckId = Text
a} :: DeleteHealthCheck)

instance Core.AWSRequest DeleteHealthCheck where
  type
    AWSResponse DeleteHealthCheck =
      DeleteHealthCheckResponse
  request :: (Service -> Service)
-> DeleteHealthCheck -> Request DeleteHealthCheck
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 DeleteHealthCheck
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteHealthCheck)))
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 -> DeleteHealthCheckResponse
DeleteHealthCheckResponse'
            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 DeleteHealthCheck where
  hashWithSalt :: Int -> DeleteHealthCheck -> Int
hashWithSalt Int
_salt DeleteHealthCheck' {Text
healthCheckId :: Text
$sel:healthCheckId:DeleteHealthCheck' :: DeleteHealthCheck -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
healthCheckId

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

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

instance Data.ToPath DeleteHealthCheck where
  toPath :: DeleteHealthCheck -> ByteString
toPath DeleteHealthCheck' {Text
healthCheckId :: Text
$sel:healthCheckId:DeleteHealthCheck' :: DeleteHealthCheck -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/2013-04-01/healthcheck/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
healthCheckId]

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

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

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

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

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