{-# 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.CreateHealthCheck
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new health check.
--
-- For information about adding health checks to resource record sets, see
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_ResourceRecordSet.html#Route53-Type-ResourceRecordSet-HealthCheckId HealthCheckId>
-- in
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_ChangeResourceRecordSets.html ChangeResourceRecordSets>.
--
-- __ELB Load Balancers__
--
-- If you\'re registering EC2 instances with an Elastic Load Balancing
-- (ELB) load balancer, do not create Amazon Route 53 health checks for the
-- EC2 instances. When you register an EC2 instance with a load balancer,
-- you configure settings for an ELB health check, which performs a similar
-- function to a Route 53 health check.
--
-- __Private Hosted Zones__
--
-- You can associate health checks with failover resource record sets in a
-- private hosted zone. Note the following:
--
-- -   Route 53 health checkers are outside the VPC. To check the health of
--     an endpoint within a VPC by IP address, you must assign a public IP
--     address to the instance in the VPC.
--
-- -   You can configure a health checker to check the health of an
--     external resource that the instance relies on, such as a database
--     server.
--
-- -   You can create a CloudWatch metric, associate an alarm with the
--     metric, and then create a health check that is based on the state of
--     the alarm. For example, you might create a CloudWatch metric that
--     checks the status of the Amazon EC2 @StatusCheckFailed@ metric, add
--     an alarm to the metric, and then create a health check that is based
--     on the state of the alarm. For information about creating CloudWatch
--     metrics and alarms by using the CloudWatch console, see the
--     <https://docs.aws.amazon.com/AmazonCloudWatch/latest/DeveloperGuide/WhatIsCloudWatch.html Amazon CloudWatch User Guide>.
module Amazonka.Route53.CreateHealthCheck
  ( -- * Creating a Request
    CreateHealthCheck (..),
    newCreateHealthCheck,

    -- * Request Lenses
    createHealthCheck_callerReference,
    createHealthCheck_healthCheckConfig,

    -- * Destructuring the Response
    CreateHealthCheckResponse (..),
    newCreateHealthCheckResponse,

    -- * Response Lenses
    createHealthCheckResponse_httpStatus,
    createHealthCheckResponse_healthCheck,
    createHealthCheckResponse_location,
  )
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

-- | A complex type that contains the health check request information.
--
-- /See:/ 'newCreateHealthCheck' smart constructor.
data CreateHealthCheck = CreateHealthCheck'
  { -- | A unique string that identifies the request and that allows you to retry
    -- a failed @CreateHealthCheck@ request without the risk of creating two
    -- identical health checks:
    --
    -- -   If you send a @CreateHealthCheck@ request with the same
    --     @CallerReference@ and settings as a previous request, and if the
    --     health check doesn\'t exist, Amazon Route 53 creates the health
    --     check. If the health check does exist, Route 53 returns the settings
    --     for the existing health check.
    --
    -- -   If you send a @CreateHealthCheck@ request with the same
    --     @CallerReference@ as a deleted health check, regardless of the
    --     settings, Route 53 returns a @HealthCheckAlreadyExists@ error.
    --
    -- -   If you send a @CreateHealthCheck@ request with the same
    --     @CallerReference@ as an existing health check but with different
    --     settings, Route 53 returns a @HealthCheckAlreadyExists@ error.
    --
    -- -   If you send a @CreateHealthCheck@ request with a unique
    --     @CallerReference@ but settings identical to an existing health
    --     check, Route 53 creates the health check.
    CreateHealthCheck -> Text
callerReference :: Prelude.Text,
    -- | A complex type that contains settings for a new health check.
    CreateHealthCheck -> HealthCheckConfig
healthCheckConfig :: HealthCheckConfig
  }
  deriving (CreateHealthCheck -> CreateHealthCheck -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHealthCheck -> CreateHealthCheck -> Bool
$c/= :: CreateHealthCheck -> CreateHealthCheck -> Bool
== :: CreateHealthCheck -> CreateHealthCheck -> Bool
$c== :: CreateHealthCheck -> CreateHealthCheck -> Bool
Prelude.Eq, ReadPrec [CreateHealthCheck]
ReadPrec CreateHealthCheck
Int -> ReadS CreateHealthCheck
ReadS [CreateHealthCheck]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHealthCheck]
$creadListPrec :: ReadPrec [CreateHealthCheck]
readPrec :: ReadPrec CreateHealthCheck
$creadPrec :: ReadPrec CreateHealthCheck
readList :: ReadS [CreateHealthCheck]
$creadList :: ReadS [CreateHealthCheck]
readsPrec :: Int -> ReadS CreateHealthCheck
$creadsPrec :: Int -> ReadS CreateHealthCheck
Prelude.Read, Int -> CreateHealthCheck -> ShowS
[CreateHealthCheck] -> ShowS
CreateHealthCheck -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHealthCheck] -> ShowS
$cshowList :: [CreateHealthCheck] -> ShowS
show :: CreateHealthCheck -> String
$cshow :: CreateHealthCheck -> String
showsPrec :: Int -> CreateHealthCheck -> ShowS
$cshowsPrec :: Int -> CreateHealthCheck -> ShowS
Prelude.Show, forall x. Rep CreateHealthCheck x -> CreateHealthCheck
forall x. CreateHealthCheck -> Rep CreateHealthCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateHealthCheck x -> CreateHealthCheck
$cfrom :: forall x. CreateHealthCheck -> Rep CreateHealthCheck x
Prelude.Generic)

-- |
-- Create a value of 'CreateHealthCheck' 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:
--
-- 'callerReference', 'createHealthCheck_callerReference' - A unique string that identifies the request and that allows you to retry
-- a failed @CreateHealthCheck@ request without the risk of creating two
-- identical health checks:
--
-- -   If you send a @CreateHealthCheck@ request with the same
--     @CallerReference@ and settings as a previous request, and if the
--     health check doesn\'t exist, Amazon Route 53 creates the health
--     check. If the health check does exist, Route 53 returns the settings
--     for the existing health check.
--
-- -   If you send a @CreateHealthCheck@ request with the same
--     @CallerReference@ as a deleted health check, regardless of the
--     settings, Route 53 returns a @HealthCheckAlreadyExists@ error.
--
-- -   If you send a @CreateHealthCheck@ request with the same
--     @CallerReference@ as an existing health check but with different
--     settings, Route 53 returns a @HealthCheckAlreadyExists@ error.
--
-- -   If you send a @CreateHealthCheck@ request with a unique
--     @CallerReference@ but settings identical to an existing health
--     check, Route 53 creates the health check.
--
-- 'healthCheckConfig', 'createHealthCheck_healthCheckConfig' - A complex type that contains settings for a new health check.
newCreateHealthCheck ::
  -- | 'callerReference'
  Prelude.Text ->
  -- | 'healthCheckConfig'
  HealthCheckConfig ->
  CreateHealthCheck
newCreateHealthCheck :: Text -> HealthCheckConfig -> CreateHealthCheck
newCreateHealthCheck
  Text
pCallerReference_
  HealthCheckConfig
pHealthCheckConfig_ =
    CreateHealthCheck'
      { $sel:callerReference:CreateHealthCheck' :: Text
callerReference =
          Text
pCallerReference_,
        $sel:healthCheckConfig:CreateHealthCheck' :: HealthCheckConfig
healthCheckConfig = HealthCheckConfig
pHealthCheckConfig_
      }

-- | A unique string that identifies the request and that allows you to retry
-- a failed @CreateHealthCheck@ request without the risk of creating two
-- identical health checks:
--
-- -   If you send a @CreateHealthCheck@ request with the same
--     @CallerReference@ and settings as a previous request, and if the
--     health check doesn\'t exist, Amazon Route 53 creates the health
--     check. If the health check does exist, Route 53 returns the settings
--     for the existing health check.
--
-- -   If you send a @CreateHealthCheck@ request with the same
--     @CallerReference@ as a deleted health check, regardless of the
--     settings, Route 53 returns a @HealthCheckAlreadyExists@ error.
--
-- -   If you send a @CreateHealthCheck@ request with the same
--     @CallerReference@ as an existing health check but with different
--     settings, Route 53 returns a @HealthCheckAlreadyExists@ error.
--
-- -   If you send a @CreateHealthCheck@ request with a unique
--     @CallerReference@ but settings identical to an existing health
--     check, Route 53 creates the health check.
createHealthCheck_callerReference :: Lens.Lens' CreateHealthCheck Prelude.Text
createHealthCheck_callerReference :: Lens' CreateHealthCheck Text
createHealthCheck_callerReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHealthCheck' {Text
callerReference :: Text
$sel:callerReference:CreateHealthCheck' :: CreateHealthCheck -> Text
callerReference} -> Text
callerReference) (\s :: CreateHealthCheck
s@CreateHealthCheck' {} Text
a -> CreateHealthCheck
s {$sel:callerReference:CreateHealthCheck' :: Text
callerReference = Text
a} :: CreateHealthCheck)

-- | A complex type that contains settings for a new health check.
createHealthCheck_healthCheckConfig :: Lens.Lens' CreateHealthCheck HealthCheckConfig
createHealthCheck_healthCheckConfig :: Lens' CreateHealthCheck HealthCheckConfig
createHealthCheck_healthCheckConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHealthCheck' {HealthCheckConfig
healthCheckConfig :: HealthCheckConfig
$sel:healthCheckConfig:CreateHealthCheck' :: CreateHealthCheck -> HealthCheckConfig
healthCheckConfig} -> HealthCheckConfig
healthCheckConfig) (\s :: CreateHealthCheck
s@CreateHealthCheck' {} HealthCheckConfig
a -> CreateHealthCheck
s {$sel:healthCheckConfig:CreateHealthCheck' :: HealthCheckConfig
healthCheckConfig = HealthCheckConfig
a} :: CreateHealthCheck)

instance Core.AWSRequest CreateHealthCheck where
  type
    AWSResponse CreateHealthCheck =
      CreateHealthCheckResponse
  request :: (Service -> Service)
-> CreateHealthCheck -> Request CreateHealthCheck
request Service -> Service
overrides =
    forall a. (ToRequest a, ToElement a) => Service -> a -> Request a
Request.postXML (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateHealthCheck
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateHealthCheck)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> HealthCheck -> Text -> CreateHealthCheckResponse
CreateHealthCheckResponse'
            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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"HealthCheck")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String a
Data..# HeaderName
"Location")
      )

instance Prelude.Hashable CreateHealthCheck where
  hashWithSalt :: Int -> CreateHealthCheck -> Int
hashWithSalt Int
_salt CreateHealthCheck' {Text
HealthCheckConfig
healthCheckConfig :: HealthCheckConfig
callerReference :: Text
$sel:healthCheckConfig:CreateHealthCheck' :: CreateHealthCheck -> HealthCheckConfig
$sel:callerReference:CreateHealthCheck' :: CreateHealthCheck -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
callerReference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HealthCheckConfig
healthCheckConfig

instance Prelude.NFData CreateHealthCheck where
  rnf :: CreateHealthCheck -> ()
rnf CreateHealthCheck' {Text
HealthCheckConfig
healthCheckConfig :: HealthCheckConfig
callerReference :: Text
$sel:healthCheckConfig:CreateHealthCheck' :: CreateHealthCheck -> HealthCheckConfig
$sel:callerReference:CreateHealthCheck' :: CreateHealthCheck -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
callerReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HealthCheckConfig
healthCheckConfig

instance Data.ToElement CreateHealthCheck where
  toElement :: CreateHealthCheck -> Element
toElement =
    forall a. ToXML a => Name -> a -> Element
Data.mkElement
      Name
"{https://route53.amazonaws.com/doc/2013-04-01/}CreateHealthCheckRequest"

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

instance Data.ToPath CreateHealthCheck where
  toPath :: CreateHealthCheck -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2013-04-01/healthcheck"

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

instance Data.ToXML CreateHealthCheck where
  toXML :: CreateHealthCheck -> XML
toXML CreateHealthCheck' {Text
HealthCheckConfig
healthCheckConfig :: HealthCheckConfig
callerReference :: Text
$sel:healthCheckConfig:CreateHealthCheck' :: CreateHealthCheck -> HealthCheckConfig
$sel:callerReference:CreateHealthCheck' :: CreateHealthCheck -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"CallerReference" forall a. ToXML a => Name -> a -> XML
Data.@= Text
callerReference,
        Name
"HealthCheckConfig" forall a. ToXML a => Name -> a -> XML
Data.@= HealthCheckConfig
healthCheckConfig
      ]

-- | A complex type containing the response information for the new health
-- check.
--
-- /See:/ 'newCreateHealthCheckResponse' smart constructor.
data CreateHealthCheckResponse = CreateHealthCheckResponse'
  { -- | The response's http status code.
    CreateHealthCheckResponse -> Int
httpStatus :: Prelude.Int,
    -- | A complex type that contains identifying information about the health
    -- check.
    CreateHealthCheckResponse -> HealthCheck
healthCheck :: HealthCheck,
    -- | The unique URL representing the new health check.
    CreateHealthCheckResponse -> Text
location :: Prelude.Text
  }
  deriving (CreateHealthCheckResponse -> CreateHealthCheckResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateHealthCheckResponse -> CreateHealthCheckResponse -> Bool
$c/= :: CreateHealthCheckResponse -> CreateHealthCheckResponse -> Bool
== :: CreateHealthCheckResponse -> CreateHealthCheckResponse -> Bool
$c== :: CreateHealthCheckResponse -> CreateHealthCheckResponse -> Bool
Prelude.Eq, ReadPrec [CreateHealthCheckResponse]
ReadPrec CreateHealthCheckResponse
Int -> ReadS CreateHealthCheckResponse
ReadS [CreateHealthCheckResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateHealthCheckResponse]
$creadListPrec :: ReadPrec [CreateHealthCheckResponse]
readPrec :: ReadPrec CreateHealthCheckResponse
$creadPrec :: ReadPrec CreateHealthCheckResponse
readList :: ReadS [CreateHealthCheckResponse]
$creadList :: ReadS [CreateHealthCheckResponse]
readsPrec :: Int -> ReadS CreateHealthCheckResponse
$creadsPrec :: Int -> ReadS CreateHealthCheckResponse
Prelude.Read, Int -> CreateHealthCheckResponse -> ShowS
[CreateHealthCheckResponse] -> ShowS
CreateHealthCheckResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateHealthCheckResponse] -> ShowS
$cshowList :: [CreateHealthCheckResponse] -> ShowS
show :: CreateHealthCheckResponse -> String
$cshow :: CreateHealthCheckResponse -> String
showsPrec :: Int -> CreateHealthCheckResponse -> ShowS
$cshowsPrec :: Int -> CreateHealthCheckResponse -> ShowS
Prelude.Show, forall x.
Rep CreateHealthCheckResponse x -> CreateHealthCheckResponse
forall x.
CreateHealthCheckResponse -> Rep CreateHealthCheckResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateHealthCheckResponse x -> CreateHealthCheckResponse
$cfrom :: forall x.
CreateHealthCheckResponse -> Rep CreateHealthCheckResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateHealthCheckResponse' 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', 'createHealthCheckResponse_httpStatus' - The response's http status code.
--
-- 'healthCheck', 'createHealthCheckResponse_healthCheck' - A complex type that contains identifying information about the health
-- check.
--
-- 'location', 'createHealthCheckResponse_location' - The unique URL representing the new health check.
newCreateHealthCheckResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'healthCheck'
  HealthCheck ->
  -- | 'location'
  Prelude.Text ->
  CreateHealthCheckResponse
newCreateHealthCheckResponse :: Int -> HealthCheck -> Text -> CreateHealthCheckResponse
newCreateHealthCheckResponse
  Int
pHttpStatus_
  HealthCheck
pHealthCheck_
  Text
pLocation_ =
    CreateHealthCheckResponse'
      { $sel:httpStatus:CreateHealthCheckResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:healthCheck:CreateHealthCheckResponse' :: HealthCheck
healthCheck = HealthCheck
pHealthCheck_,
        $sel:location:CreateHealthCheckResponse' :: Text
location = Text
pLocation_
      }

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

-- | A complex type that contains identifying information about the health
-- check.
createHealthCheckResponse_healthCheck :: Lens.Lens' CreateHealthCheckResponse HealthCheck
createHealthCheckResponse_healthCheck :: Lens' CreateHealthCheckResponse HealthCheck
createHealthCheckResponse_healthCheck = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHealthCheckResponse' {HealthCheck
healthCheck :: HealthCheck
$sel:healthCheck:CreateHealthCheckResponse' :: CreateHealthCheckResponse -> HealthCheck
healthCheck} -> HealthCheck
healthCheck) (\s :: CreateHealthCheckResponse
s@CreateHealthCheckResponse' {} HealthCheck
a -> CreateHealthCheckResponse
s {$sel:healthCheck:CreateHealthCheckResponse' :: HealthCheck
healthCheck = HealthCheck
a} :: CreateHealthCheckResponse)

-- | The unique URL representing the new health check.
createHealthCheckResponse_location :: Lens.Lens' CreateHealthCheckResponse Prelude.Text
createHealthCheckResponse_location :: Lens' CreateHealthCheckResponse Text
createHealthCheckResponse_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateHealthCheckResponse' {Text
location :: Text
$sel:location:CreateHealthCheckResponse' :: CreateHealthCheckResponse -> Text
location} -> Text
location) (\s :: CreateHealthCheckResponse
s@CreateHealthCheckResponse' {} Text
a -> CreateHealthCheckResponse
s {$sel:location:CreateHealthCheckResponse' :: Text
location = Text
a} :: CreateHealthCheckResponse)

instance Prelude.NFData CreateHealthCheckResponse where
  rnf :: CreateHealthCheckResponse -> ()
rnf CreateHealthCheckResponse' {Int
Text
HealthCheck
location :: Text
healthCheck :: HealthCheck
httpStatus :: Int
$sel:location:CreateHealthCheckResponse' :: CreateHealthCheckResponse -> Text
$sel:healthCheck:CreateHealthCheckResponse' :: CreateHealthCheckResponse -> HealthCheck
$sel:httpStatus:CreateHealthCheckResponse' :: CreateHealthCheckResponse -> 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 HealthCheck
healthCheck
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
location