{-# 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.Route53RecoveryReadiness.UpdateReadinessCheck
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a readiness check.
module Amazonka.Route53RecoveryReadiness.UpdateReadinessCheck
  ( -- * Creating a Request
    UpdateReadinessCheck (..),
    newUpdateReadinessCheck,

    -- * Request Lenses
    updateReadinessCheck_readinessCheckName,
    updateReadinessCheck_resourceSetName,

    -- * Destructuring the Response
    UpdateReadinessCheckResponse (..),
    newUpdateReadinessCheckResponse,

    -- * Response Lenses
    updateReadinessCheckResponse_readinessCheckArn,
    updateReadinessCheckResponse_readinessCheckName,
    updateReadinessCheckResponse_resourceSet,
    updateReadinessCheckResponse_tags,
    updateReadinessCheckResponse_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.Route53RecoveryReadiness.Types

-- | Name of a readiness check to describe.
--
-- /See:/ 'newUpdateReadinessCheck' smart constructor.
data UpdateReadinessCheck = UpdateReadinessCheck'
  { -- | Name of a readiness check.
    UpdateReadinessCheck -> Text
readinessCheckName :: Prelude.Text,
    -- | The name of the resource set to be checked.
    UpdateReadinessCheck -> Text
resourceSetName :: Prelude.Text
  }
  deriving (UpdateReadinessCheck -> UpdateReadinessCheck -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateReadinessCheck -> UpdateReadinessCheck -> Bool
$c/= :: UpdateReadinessCheck -> UpdateReadinessCheck -> Bool
== :: UpdateReadinessCheck -> UpdateReadinessCheck -> Bool
$c== :: UpdateReadinessCheck -> UpdateReadinessCheck -> Bool
Prelude.Eq, ReadPrec [UpdateReadinessCheck]
ReadPrec UpdateReadinessCheck
Int -> ReadS UpdateReadinessCheck
ReadS [UpdateReadinessCheck]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateReadinessCheck]
$creadListPrec :: ReadPrec [UpdateReadinessCheck]
readPrec :: ReadPrec UpdateReadinessCheck
$creadPrec :: ReadPrec UpdateReadinessCheck
readList :: ReadS [UpdateReadinessCheck]
$creadList :: ReadS [UpdateReadinessCheck]
readsPrec :: Int -> ReadS UpdateReadinessCheck
$creadsPrec :: Int -> ReadS UpdateReadinessCheck
Prelude.Read, Int -> UpdateReadinessCheck -> ShowS
[UpdateReadinessCheck] -> ShowS
UpdateReadinessCheck -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateReadinessCheck] -> ShowS
$cshowList :: [UpdateReadinessCheck] -> ShowS
show :: UpdateReadinessCheck -> String
$cshow :: UpdateReadinessCheck -> String
showsPrec :: Int -> UpdateReadinessCheck -> ShowS
$cshowsPrec :: Int -> UpdateReadinessCheck -> ShowS
Prelude.Show, forall x. Rep UpdateReadinessCheck x -> UpdateReadinessCheck
forall x. UpdateReadinessCheck -> Rep UpdateReadinessCheck x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateReadinessCheck x -> UpdateReadinessCheck
$cfrom :: forall x. UpdateReadinessCheck -> Rep UpdateReadinessCheck x
Prelude.Generic)

-- |
-- Create a value of 'UpdateReadinessCheck' 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:
--
-- 'readinessCheckName', 'updateReadinessCheck_readinessCheckName' - Name of a readiness check.
--
-- 'resourceSetName', 'updateReadinessCheck_resourceSetName' - The name of the resource set to be checked.
newUpdateReadinessCheck ::
  -- | 'readinessCheckName'
  Prelude.Text ->
  -- | 'resourceSetName'
  Prelude.Text ->
  UpdateReadinessCheck
newUpdateReadinessCheck :: Text -> Text -> UpdateReadinessCheck
newUpdateReadinessCheck
  Text
pReadinessCheckName_
  Text
pResourceSetName_ =
    UpdateReadinessCheck'
      { $sel:readinessCheckName:UpdateReadinessCheck' :: Text
readinessCheckName =
          Text
pReadinessCheckName_,
        $sel:resourceSetName:UpdateReadinessCheck' :: Text
resourceSetName = Text
pResourceSetName_
      }

-- | Name of a readiness check.
updateReadinessCheck_readinessCheckName :: Lens.Lens' UpdateReadinessCheck Prelude.Text
updateReadinessCheck_readinessCheckName :: Lens' UpdateReadinessCheck Text
updateReadinessCheck_readinessCheckName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReadinessCheck' {Text
readinessCheckName :: Text
$sel:readinessCheckName:UpdateReadinessCheck' :: UpdateReadinessCheck -> Text
readinessCheckName} -> Text
readinessCheckName) (\s :: UpdateReadinessCheck
s@UpdateReadinessCheck' {} Text
a -> UpdateReadinessCheck
s {$sel:readinessCheckName:UpdateReadinessCheck' :: Text
readinessCheckName = Text
a} :: UpdateReadinessCheck)

-- | The name of the resource set to be checked.
updateReadinessCheck_resourceSetName :: Lens.Lens' UpdateReadinessCheck Prelude.Text
updateReadinessCheck_resourceSetName :: Lens' UpdateReadinessCheck Text
updateReadinessCheck_resourceSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReadinessCheck' {Text
resourceSetName :: Text
$sel:resourceSetName:UpdateReadinessCheck' :: UpdateReadinessCheck -> Text
resourceSetName} -> Text
resourceSetName) (\s :: UpdateReadinessCheck
s@UpdateReadinessCheck' {} Text
a -> UpdateReadinessCheck
s {$sel:resourceSetName:UpdateReadinessCheck' :: Text
resourceSetName = Text
a} :: UpdateReadinessCheck)

instance Core.AWSRequest UpdateReadinessCheck where
  type
    AWSResponse UpdateReadinessCheck =
      UpdateReadinessCheckResponse
  request :: (Service -> Service)
-> UpdateReadinessCheck -> Request UpdateReadinessCheck
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateReadinessCheck
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateReadinessCheck)))
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 ->
          Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> UpdateReadinessCheckResponse
UpdateReadinessCheckResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"readinessCheckArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"readinessCheckName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"resourceSet")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => 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 UpdateReadinessCheck where
  hashWithSalt :: Int -> UpdateReadinessCheck -> Int
hashWithSalt Int
_salt UpdateReadinessCheck' {Text
resourceSetName :: Text
readinessCheckName :: Text
$sel:resourceSetName:UpdateReadinessCheck' :: UpdateReadinessCheck -> Text
$sel:readinessCheckName:UpdateReadinessCheck' :: UpdateReadinessCheck -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
readinessCheckName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceSetName

instance Prelude.NFData UpdateReadinessCheck where
  rnf :: UpdateReadinessCheck -> ()
rnf UpdateReadinessCheck' {Text
resourceSetName :: Text
readinessCheckName :: Text
$sel:resourceSetName:UpdateReadinessCheck' :: UpdateReadinessCheck -> Text
$sel:readinessCheckName:UpdateReadinessCheck' :: UpdateReadinessCheck -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
readinessCheckName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceSetName

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

instance Data.ToPath UpdateReadinessCheck where
  toPath :: UpdateReadinessCheck -> ByteString
toPath UpdateReadinessCheck' {Text
resourceSetName :: Text
readinessCheckName :: Text
$sel:resourceSetName:UpdateReadinessCheck' :: UpdateReadinessCheck -> Text
$sel:readinessCheckName:UpdateReadinessCheck' :: UpdateReadinessCheck -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/readinesschecks/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
readinessCheckName]

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

-- | /See:/ 'newUpdateReadinessCheckResponse' smart constructor.
data UpdateReadinessCheckResponse = UpdateReadinessCheckResponse'
  { -- | The Amazon Resource Name (ARN) associated with a readiness check.
    UpdateReadinessCheckResponse -> Maybe Text
readinessCheckArn :: Prelude.Maybe Prelude.Text,
    -- | Name of a readiness check.
    UpdateReadinessCheckResponse -> Maybe Text
readinessCheckName :: Prelude.Maybe Prelude.Text,
    -- | Name of the resource set to be checked.
    UpdateReadinessCheckResponse -> Maybe Text
resourceSet :: Prelude.Maybe Prelude.Text,
    UpdateReadinessCheckResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    UpdateReadinessCheckResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateReadinessCheckResponse
-> UpdateReadinessCheckResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateReadinessCheckResponse
-> UpdateReadinessCheckResponse -> Bool
$c/= :: UpdateReadinessCheckResponse
-> UpdateReadinessCheckResponse -> Bool
== :: UpdateReadinessCheckResponse
-> UpdateReadinessCheckResponse -> Bool
$c== :: UpdateReadinessCheckResponse
-> UpdateReadinessCheckResponse -> Bool
Prelude.Eq, ReadPrec [UpdateReadinessCheckResponse]
ReadPrec UpdateReadinessCheckResponse
Int -> ReadS UpdateReadinessCheckResponse
ReadS [UpdateReadinessCheckResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateReadinessCheckResponse]
$creadListPrec :: ReadPrec [UpdateReadinessCheckResponse]
readPrec :: ReadPrec UpdateReadinessCheckResponse
$creadPrec :: ReadPrec UpdateReadinessCheckResponse
readList :: ReadS [UpdateReadinessCheckResponse]
$creadList :: ReadS [UpdateReadinessCheckResponse]
readsPrec :: Int -> ReadS UpdateReadinessCheckResponse
$creadsPrec :: Int -> ReadS UpdateReadinessCheckResponse
Prelude.Read, Int -> UpdateReadinessCheckResponse -> ShowS
[UpdateReadinessCheckResponse] -> ShowS
UpdateReadinessCheckResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateReadinessCheckResponse] -> ShowS
$cshowList :: [UpdateReadinessCheckResponse] -> ShowS
show :: UpdateReadinessCheckResponse -> String
$cshow :: UpdateReadinessCheckResponse -> String
showsPrec :: Int -> UpdateReadinessCheckResponse -> ShowS
$cshowsPrec :: Int -> UpdateReadinessCheckResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateReadinessCheckResponse x -> UpdateReadinessCheckResponse
forall x.
UpdateReadinessCheckResponse -> Rep UpdateReadinessCheckResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateReadinessCheckResponse x -> UpdateReadinessCheckResponse
$cfrom :: forall x.
UpdateReadinessCheckResponse -> Rep UpdateReadinessCheckResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateReadinessCheckResponse' 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:
--
-- 'readinessCheckArn', 'updateReadinessCheckResponse_readinessCheckArn' - The Amazon Resource Name (ARN) associated with a readiness check.
--
-- 'readinessCheckName', 'updateReadinessCheckResponse_readinessCheckName' - Name of a readiness check.
--
-- 'resourceSet', 'updateReadinessCheckResponse_resourceSet' - Name of the resource set to be checked.
--
-- 'tags', 'updateReadinessCheckResponse_tags' - Undocumented member.
--
-- 'httpStatus', 'updateReadinessCheckResponse_httpStatus' - The response's http status code.
newUpdateReadinessCheckResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateReadinessCheckResponse
newUpdateReadinessCheckResponse :: Int -> UpdateReadinessCheckResponse
newUpdateReadinessCheckResponse Int
pHttpStatus_ =
  UpdateReadinessCheckResponse'
    { $sel:readinessCheckArn:UpdateReadinessCheckResponse' :: Maybe Text
readinessCheckArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:readinessCheckName:UpdateReadinessCheckResponse' :: Maybe Text
readinessCheckName = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceSet:UpdateReadinessCheckResponse' :: Maybe Text
resourceSet = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:UpdateReadinessCheckResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateReadinessCheckResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) associated with a readiness check.
updateReadinessCheckResponse_readinessCheckArn :: Lens.Lens' UpdateReadinessCheckResponse (Prelude.Maybe Prelude.Text)
updateReadinessCheckResponse_readinessCheckArn :: Lens' UpdateReadinessCheckResponse (Maybe Text)
updateReadinessCheckResponse_readinessCheckArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReadinessCheckResponse' {Maybe Text
readinessCheckArn :: Maybe Text
$sel:readinessCheckArn:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Maybe Text
readinessCheckArn} -> Maybe Text
readinessCheckArn) (\s :: UpdateReadinessCheckResponse
s@UpdateReadinessCheckResponse' {} Maybe Text
a -> UpdateReadinessCheckResponse
s {$sel:readinessCheckArn:UpdateReadinessCheckResponse' :: Maybe Text
readinessCheckArn = Maybe Text
a} :: UpdateReadinessCheckResponse)

-- | Name of a readiness check.
updateReadinessCheckResponse_readinessCheckName :: Lens.Lens' UpdateReadinessCheckResponse (Prelude.Maybe Prelude.Text)
updateReadinessCheckResponse_readinessCheckName :: Lens' UpdateReadinessCheckResponse (Maybe Text)
updateReadinessCheckResponse_readinessCheckName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReadinessCheckResponse' {Maybe Text
readinessCheckName :: Maybe Text
$sel:readinessCheckName:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Maybe Text
readinessCheckName} -> Maybe Text
readinessCheckName) (\s :: UpdateReadinessCheckResponse
s@UpdateReadinessCheckResponse' {} Maybe Text
a -> UpdateReadinessCheckResponse
s {$sel:readinessCheckName:UpdateReadinessCheckResponse' :: Maybe Text
readinessCheckName = Maybe Text
a} :: UpdateReadinessCheckResponse)

-- | Name of the resource set to be checked.
updateReadinessCheckResponse_resourceSet :: Lens.Lens' UpdateReadinessCheckResponse (Prelude.Maybe Prelude.Text)
updateReadinessCheckResponse_resourceSet :: Lens' UpdateReadinessCheckResponse (Maybe Text)
updateReadinessCheckResponse_resourceSet = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReadinessCheckResponse' {Maybe Text
resourceSet :: Maybe Text
$sel:resourceSet:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Maybe Text
resourceSet} -> Maybe Text
resourceSet) (\s :: UpdateReadinessCheckResponse
s@UpdateReadinessCheckResponse' {} Maybe Text
a -> UpdateReadinessCheckResponse
s {$sel:resourceSet:UpdateReadinessCheckResponse' :: Maybe Text
resourceSet = Maybe Text
a} :: UpdateReadinessCheckResponse)

-- | Undocumented member.
updateReadinessCheckResponse_tags :: Lens.Lens' UpdateReadinessCheckResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
updateReadinessCheckResponse_tags :: Lens' UpdateReadinessCheckResponse (Maybe (HashMap Text Text))
updateReadinessCheckResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateReadinessCheckResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: UpdateReadinessCheckResponse
s@UpdateReadinessCheckResponse' {} Maybe (HashMap Text Text)
a -> UpdateReadinessCheckResponse
s {$sel:tags:UpdateReadinessCheckResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: UpdateReadinessCheckResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData UpdateReadinessCheckResponse where
  rnf :: UpdateReadinessCheckResponse -> ()
rnf UpdateReadinessCheckResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
resourceSet :: Maybe Text
readinessCheckName :: Maybe Text
readinessCheckArn :: Maybe Text
$sel:httpStatus:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Int
$sel:tags:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Maybe (HashMap Text Text)
$sel:resourceSet:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Maybe Text
$sel:readinessCheckName:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Maybe Text
$sel:readinessCheckArn:UpdateReadinessCheckResponse' :: UpdateReadinessCheckResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
readinessCheckArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
readinessCheckName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceSet
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus