{-# 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.GetHealthCheck
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets information about a specified health check.
module Amazonka.Route53.GetHealthCheck
  ( -- * Creating a Request
    GetHealthCheck (..),
    newGetHealthCheck,

    -- * Request Lenses
    getHealthCheck_healthCheckId,

    -- * Destructuring the Response
    GetHealthCheckResponse (..),
    newGetHealthCheckResponse,

    -- * Response Lenses
    getHealthCheckResponse_httpStatus,
    getHealthCheckResponse_healthCheck,
  )
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 request to get information about a specified health check.
--
-- /See:/ 'newGetHealthCheck' smart constructor.
data GetHealthCheck = GetHealthCheck'
  { -- | The identifier that Amazon Route 53 assigned to the health check when
    -- you created it. When you add or update a resource record set, you use
    -- this value to specify which health check to use. The value can be up to
    -- 64 characters long.
    GetHealthCheck -> Text
healthCheckId :: Prelude.Text
  }
  deriving (GetHealthCheck -> GetHealthCheck -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHealthCheck -> GetHealthCheck -> Bool
$c/= :: GetHealthCheck -> GetHealthCheck -> Bool
== :: GetHealthCheck -> GetHealthCheck -> Bool
$c== :: GetHealthCheck -> GetHealthCheck -> Bool
Prelude.Eq, ReadPrec [GetHealthCheck]
ReadPrec GetHealthCheck
Int -> ReadS GetHealthCheck
ReadS [GetHealthCheck]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHealthCheck]
$creadListPrec :: ReadPrec [GetHealthCheck]
readPrec :: ReadPrec GetHealthCheck
$creadPrec :: ReadPrec GetHealthCheck
readList :: ReadS [GetHealthCheck]
$creadList :: ReadS [GetHealthCheck]
readsPrec :: Int -> ReadS GetHealthCheck
$creadsPrec :: Int -> ReadS GetHealthCheck
Prelude.Read, Int -> GetHealthCheck -> ShowS
[GetHealthCheck] -> ShowS
GetHealthCheck -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHealthCheck] -> ShowS
$cshowList :: [GetHealthCheck] -> ShowS
show :: GetHealthCheck -> String
$cshow :: GetHealthCheck -> String
showsPrec :: Int -> GetHealthCheck -> ShowS
$cshowsPrec :: Int -> GetHealthCheck -> ShowS
Prelude.Show, forall x. Rep GetHealthCheck x -> GetHealthCheck
forall x. GetHealthCheck -> Rep GetHealthCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetHealthCheck x -> GetHealthCheck
$cfrom :: forall x. GetHealthCheck -> Rep GetHealthCheck x
Prelude.Generic)

-- |
-- Create a value of 'GetHealthCheck' 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', 'getHealthCheck_healthCheckId' - The identifier that Amazon Route 53 assigned to the health check when
-- you created it. When you add or update a resource record set, you use
-- this value to specify which health check to use. The value can be up to
-- 64 characters long.
newGetHealthCheck ::
  -- | 'healthCheckId'
  Prelude.Text ->
  GetHealthCheck
newGetHealthCheck :: Text -> GetHealthCheck
newGetHealthCheck Text
pHealthCheckId_ =
  GetHealthCheck' {$sel:healthCheckId:GetHealthCheck' :: Text
healthCheckId = Text
pHealthCheckId_}

-- | The identifier that Amazon Route 53 assigned to the health check when
-- you created it. When you add or update a resource record set, you use
-- this value to specify which health check to use. The value can be up to
-- 64 characters long.
getHealthCheck_healthCheckId :: Lens.Lens' GetHealthCheck Prelude.Text
getHealthCheck_healthCheckId :: Lens' GetHealthCheck Text
getHealthCheck_healthCheckId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHealthCheck' {Text
healthCheckId :: Text
$sel:healthCheckId:GetHealthCheck' :: GetHealthCheck -> Text
healthCheckId} -> Text
healthCheckId) (\s :: GetHealthCheck
s@GetHealthCheck' {} Text
a -> GetHealthCheck
s {$sel:healthCheckId:GetHealthCheck' :: Text
healthCheckId = Text
a} :: GetHealthCheck)

instance Core.AWSRequest GetHealthCheck where
  type
    AWSResponse GetHealthCheck =
      GetHealthCheckResponse
  request :: (Service -> Service) -> GetHealthCheck -> Request GetHealthCheck
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetHealthCheck
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetHealthCheck)))
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 -> GetHealthCheckResponse
GetHealthCheckResponse'
            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")
      )

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

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

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

instance Data.ToPath GetHealthCheck where
  toPath :: GetHealthCheck -> ByteString
toPath GetHealthCheck' {Text
healthCheckId :: Text
$sel:healthCheckId:GetHealthCheck' :: GetHealthCheck -> 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 GetHealthCheck where
  toQuery :: GetHealthCheck -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | A complex type that contains the response to a @GetHealthCheck@ request.
--
-- /See:/ 'newGetHealthCheckResponse' smart constructor.
data GetHealthCheckResponse = GetHealthCheckResponse'
  { -- | The response's http status code.
    GetHealthCheckResponse -> Int
httpStatus :: Prelude.Int,
    -- | A complex type that contains information about one health check that is
    -- associated with the current Amazon Web Services account.
    GetHealthCheckResponse -> HealthCheck
healthCheck :: HealthCheck
  }
  deriving (GetHealthCheckResponse -> GetHealthCheckResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetHealthCheckResponse -> GetHealthCheckResponse -> Bool
$c/= :: GetHealthCheckResponse -> GetHealthCheckResponse -> Bool
== :: GetHealthCheckResponse -> GetHealthCheckResponse -> Bool
$c== :: GetHealthCheckResponse -> GetHealthCheckResponse -> Bool
Prelude.Eq, ReadPrec [GetHealthCheckResponse]
ReadPrec GetHealthCheckResponse
Int -> ReadS GetHealthCheckResponse
ReadS [GetHealthCheckResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetHealthCheckResponse]
$creadListPrec :: ReadPrec [GetHealthCheckResponse]
readPrec :: ReadPrec GetHealthCheckResponse
$creadPrec :: ReadPrec GetHealthCheckResponse
readList :: ReadS [GetHealthCheckResponse]
$creadList :: ReadS [GetHealthCheckResponse]
readsPrec :: Int -> ReadS GetHealthCheckResponse
$creadsPrec :: Int -> ReadS GetHealthCheckResponse
Prelude.Read, Int -> GetHealthCheckResponse -> ShowS
[GetHealthCheckResponse] -> ShowS
GetHealthCheckResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetHealthCheckResponse] -> ShowS
$cshowList :: [GetHealthCheckResponse] -> ShowS
show :: GetHealthCheckResponse -> String
$cshow :: GetHealthCheckResponse -> String
showsPrec :: Int -> GetHealthCheckResponse -> ShowS
$cshowsPrec :: Int -> GetHealthCheckResponse -> ShowS
Prelude.Show, forall x. Rep GetHealthCheckResponse x -> GetHealthCheckResponse
forall x. GetHealthCheckResponse -> Rep GetHealthCheckResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetHealthCheckResponse x -> GetHealthCheckResponse
$cfrom :: forall x. GetHealthCheckResponse -> Rep GetHealthCheckResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetHealthCheckResponse' 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', 'getHealthCheckResponse_httpStatus' - The response's http status code.
--
-- 'healthCheck', 'getHealthCheckResponse_healthCheck' - A complex type that contains information about one health check that is
-- associated with the current Amazon Web Services account.
newGetHealthCheckResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'healthCheck'
  HealthCheck ->
  GetHealthCheckResponse
newGetHealthCheckResponse :: Int -> HealthCheck -> GetHealthCheckResponse
newGetHealthCheckResponse Int
pHttpStatus_ HealthCheck
pHealthCheck_ =
  GetHealthCheckResponse'
    { $sel:httpStatus:GetHealthCheckResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:healthCheck:GetHealthCheckResponse' :: HealthCheck
healthCheck = HealthCheck
pHealthCheck_
    }

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

-- | A complex type that contains information about one health check that is
-- associated with the current Amazon Web Services account.
getHealthCheckResponse_healthCheck :: Lens.Lens' GetHealthCheckResponse HealthCheck
getHealthCheckResponse_healthCheck :: Lens' GetHealthCheckResponse HealthCheck
getHealthCheckResponse_healthCheck = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetHealthCheckResponse' {HealthCheck
healthCheck :: HealthCheck
$sel:healthCheck:GetHealthCheckResponse' :: GetHealthCheckResponse -> HealthCheck
healthCheck} -> HealthCheck
healthCheck) (\s :: GetHealthCheckResponse
s@GetHealthCheckResponse' {} HealthCheck
a -> GetHealthCheckResponse
s {$sel:healthCheck:GetHealthCheckResponse' :: HealthCheck
healthCheck = HealthCheck
a} :: GetHealthCheckResponse)

instance Prelude.NFData GetHealthCheckResponse where
  rnf :: GetHealthCheckResponse -> ()
rnf GetHealthCheckResponse' {Int
HealthCheck
healthCheck :: HealthCheck
httpStatus :: Int
$sel:healthCheck:GetHealthCheckResponse' :: GetHealthCheckResponse -> HealthCheck
$sel:httpStatus:GetHealthCheckResponse' :: GetHealthCheckResponse -> 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