{-# 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.CloudFormation.RecordHandlerProgress
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Reports progress of a resource handler to CloudFormation.
--
-- Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
-- Don\'t use this API in your code.
module Amazonka.CloudFormation.RecordHandlerProgress
  ( -- * Creating a Request
    RecordHandlerProgress (..),
    newRecordHandlerProgress,

    -- * Request Lenses
    recordHandlerProgress_clientRequestToken,
    recordHandlerProgress_currentOperationStatus,
    recordHandlerProgress_errorCode,
    recordHandlerProgress_resourceModel,
    recordHandlerProgress_statusMessage,
    recordHandlerProgress_bearerToken,
    recordHandlerProgress_operationStatus,

    -- * Destructuring the Response
    RecordHandlerProgressResponse (..),
    newRecordHandlerProgressResponse,

    -- * Response Lenses
    recordHandlerProgressResponse_httpStatus,
  )
where

import Amazonka.CloudFormation.Types
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

-- | /See:/ 'newRecordHandlerProgress' smart constructor.
data RecordHandlerProgress = RecordHandlerProgress'
  { -- | Reserved for use by the
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
    RecordHandlerProgress -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | Reserved for use by the
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
    RecordHandlerProgress -> Maybe OperationStatus
currentOperationStatus :: Prelude.Maybe OperationStatus,
    -- | Reserved for use by the
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
    RecordHandlerProgress -> Maybe HandlerErrorCode
errorCode :: Prelude.Maybe HandlerErrorCode,
    -- | Reserved for use by the
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
    RecordHandlerProgress -> Maybe Text
resourceModel :: Prelude.Maybe Prelude.Text,
    -- | Reserved for use by the
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
    RecordHandlerProgress -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | Reserved for use by the
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
    RecordHandlerProgress -> Text
bearerToken :: Prelude.Text,
    -- | Reserved for use by the
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
    RecordHandlerProgress -> OperationStatus
operationStatus :: OperationStatus
  }
  deriving (RecordHandlerProgress -> RecordHandlerProgress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RecordHandlerProgress -> RecordHandlerProgress -> Bool
$c/= :: RecordHandlerProgress -> RecordHandlerProgress -> Bool
== :: RecordHandlerProgress -> RecordHandlerProgress -> Bool
$c== :: RecordHandlerProgress -> RecordHandlerProgress -> Bool
Prelude.Eq, ReadPrec [RecordHandlerProgress]
ReadPrec RecordHandlerProgress
Int -> ReadS RecordHandlerProgress
ReadS [RecordHandlerProgress]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RecordHandlerProgress]
$creadListPrec :: ReadPrec [RecordHandlerProgress]
readPrec :: ReadPrec RecordHandlerProgress
$creadPrec :: ReadPrec RecordHandlerProgress
readList :: ReadS [RecordHandlerProgress]
$creadList :: ReadS [RecordHandlerProgress]
readsPrec :: Int -> ReadS RecordHandlerProgress
$creadsPrec :: Int -> ReadS RecordHandlerProgress
Prelude.Read, Int -> RecordHandlerProgress -> ShowS
[RecordHandlerProgress] -> ShowS
RecordHandlerProgress -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RecordHandlerProgress] -> ShowS
$cshowList :: [RecordHandlerProgress] -> ShowS
show :: RecordHandlerProgress -> String
$cshow :: RecordHandlerProgress -> String
showsPrec :: Int -> RecordHandlerProgress -> ShowS
$cshowsPrec :: Int -> RecordHandlerProgress -> ShowS
Prelude.Show, forall x. Rep RecordHandlerProgress x -> RecordHandlerProgress
forall x. RecordHandlerProgress -> Rep RecordHandlerProgress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RecordHandlerProgress x -> RecordHandlerProgress
$cfrom :: forall x. RecordHandlerProgress -> Rep RecordHandlerProgress x
Prelude.Generic)

-- |
-- Create a value of 'RecordHandlerProgress' 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:
--
-- 'clientRequestToken', 'recordHandlerProgress_clientRequestToken' - Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
--
-- 'currentOperationStatus', 'recordHandlerProgress_currentOperationStatus' - Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
--
-- 'errorCode', 'recordHandlerProgress_errorCode' - Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
--
-- 'resourceModel', 'recordHandlerProgress_resourceModel' - Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
--
-- 'statusMessage', 'recordHandlerProgress_statusMessage' - Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
--
-- 'bearerToken', 'recordHandlerProgress_bearerToken' - Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
--
-- 'operationStatus', 'recordHandlerProgress_operationStatus' - Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
newRecordHandlerProgress ::
  -- | 'bearerToken'
  Prelude.Text ->
  -- | 'operationStatus'
  OperationStatus ->
  RecordHandlerProgress
newRecordHandlerProgress :: Text -> OperationStatus -> RecordHandlerProgress
newRecordHandlerProgress
  Text
pBearerToken_
  OperationStatus
pOperationStatus_ =
    RecordHandlerProgress'
      { $sel:clientRequestToken:RecordHandlerProgress' :: Maybe Text
clientRequestToken =
          forall a. Maybe a
Prelude.Nothing,
        $sel:currentOperationStatus:RecordHandlerProgress' :: Maybe OperationStatus
currentOperationStatus = forall a. Maybe a
Prelude.Nothing,
        $sel:errorCode:RecordHandlerProgress' :: Maybe HandlerErrorCode
errorCode = forall a. Maybe a
Prelude.Nothing,
        $sel:resourceModel:RecordHandlerProgress' :: Maybe Text
resourceModel = forall a. Maybe a
Prelude.Nothing,
        $sel:statusMessage:RecordHandlerProgress' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
        $sel:bearerToken:RecordHandlerProgress' :: Text
bearerToken = Text
pBearerToken_,
        $sel:operationStatus:RecordHandlerProgress' :: OperationStatus
operationStatus = OperationStatus
pOperationStatus_
      }

-- | Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
recordHandlerProgress_clientRequestToken :: Lens.Lens' RecordHandlerProgress (Prelude.Maybe Prelude.Text)
recordHandlerProgress_clientRequestToken :: Lens' RecordHandlerProgress (Maybe Text)
recordHandlerProgress_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecordHandlerProgress' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: RecordHandlerProgress
s@RecordHandlerProgress' {} Maybe Text
a -> RecordHandlerProgress
s {$sel:clientRequestToken:RecordHandlerProgress' :: Maybe Text
clientRequestToken = Maybe Text
a} :: RecordHandlerProgress)

-- | Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
recordHandlerProgress_currentOperationStatus :: Lens.Lens' RecordHandlerProgress (Prelude.Maybe OperationStatus)
recordHandlerProgress_currentOperationStatus :: Lens' RecordHandlerProgress (Maybe OperationStatus)
recordHandlerProgress_currentOperationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecordHandlerProgress' {Maybe OperationStatus
currentOperationStatus :: Maybe OperationStatus
$sel:currentOperationStatus:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe OperationStatus
currentOperationStatus} -> Maybe OperationStatus
currentOperationStatus) (\s :: RecordHandlerProgress
s@RecordHandlerProgress' {} Maybe OperationStatus
a -> RecordHandlerProgress
s {$sel:currentOperationStatus:RecordHandlerProgress' :: Maybe OperationStatus
currentOperationStatus = Maybe OperationStatus
a} :: RecordHandlerProgress)

-- | Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
recordHandlerProgress_errorCode :: Lens.Lens' RecordHandlerProgress (Prelude.Maybe HandlerErrorCode)
recordHandlerProgress_errorCode :: Lens' RecordHandlerProgress (Maybe HandlerErrorCode)
recordHandlerProgress_errorCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecordHandlerProgress' {Maybe HandlerErrorCode
errorCode :: Maybe HandlerErrorCode
$sel:errorCode:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe HandlerErrorCode
errorCode} -> Maybe HandlerErrorCode
errorCode) (\s :: RecordHandlerProgress
s@RecordHandlerProgress' {} Maybe HandlerErrorCode
a -> RecordHandlerProgress
s {$sel:errorCode:RecordHandlerProgress' :: Maybe HandlerErrorCode
errorCode = Maybe HandlerErrorCode
a} :: RecordHandlerProgress)

-- | Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
recordHandlerProgress_resourceModel :: Lens.Lens' RecordHandlerProgress (Prelude.Maybe Prelude.Text)
recordHandlerProgress_resourceModel :: Lens' RecordHandlerProgress (Maybe Text)
recordHandlerProgress_resourceModel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecordHandlerProgress' {Maybe Text
resourceModel :: Maybe Text
$sel:resourceModel:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
resourceModel} -> Maybe Text
resourceModel) (\s :: RecordHandlerProgress
s@RecordHandlerProgress' {} Maybe Text
a -> RecordHandlerProgress
s {$sel:resourceModel:RecordHandlerProgress' :: Maybe Text
resourceModel = Maybe Text
a} :: RecordHandlerProgress)

-- | Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
recordHandlerProgress_statusMessage :: Lens.Lens' RecordHandlerProgress (Prelude.Maybe Prelude.Text)
recordHandlerProgress_statusMessage :: Lens' RecordHandlerProgress (Maybe Text)
recordHandlerProgress_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecordHandlerProgress' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: RecordHandlerProgress
s@RecordHandlerProgress' {} Maybe Text
a -> RecordHandlerProgress
s {$sel:statusMessage:RecordHandlerProgress' :: Maybe Text
statusMessage = Maybe Text
a} :: RecordHandlerProgress)

-- | Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
recordHandlerProgress_bearerToken :: Lens.Lens' RecordHandlerProgress Prelude.Text
recordHandlerProgress_bearerToken :: Lens' RecordHandlerProgress Text
recordHandlerProgress_bearerToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecordHandlerProgress' {Text
bearerToken :: Text
$sel:bearerToken:RecordHandlerProgress' :: RecordHandlerProgress -> Text
bearerToken} -> Text
bearerToken) (\s :: RecordHandlerProgress
s@RecordHandlerProgress' {} Text
a -> RecordHandlerProgress
s {$sel:bearerToken:RecordHandlerProgress' :: Text
bearerToken = Text
a} :: RecordHandlerProgress)

-- | Reserved for use by the
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/what-is-cloudformation-cli.html CloudFormation CLI>.
recordHandlerProgress_operationStatus :: Lens.Lens' RecordHandlerProgress OperationStatus
recordHandlerProgress_operationStatus :: Lens' RecordHandlerProgress OperationStatus
recordHandlerProgress_operationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RecordHandlerProgress' {OperationStatus
operationStatus :: OperationStatus
$sel:operationStatus:RecordHandlerProgress' :: RecordHandlerProgress -> OperationStatus
operationStatus} -> OperationStatus
operationStatus) (\s :: RecordHandlerProgress
s@RecordHandlerProgress' {} OperationStatus
a -> RecordHandlerProgress
s {$sel:operationStatus:RecordHandlerProgress' :: OperationStatus
operationStatus = OperationStatus
a} :: RecordHandlerProgress)

instance Core.AWSRequest RecordHandlerProgress where
  type
    AWSResponse RecordHandlerProgress =
      RecordHandlerProgressResponse
  request :: (Service -> Service)
-> RecordHandlerProgress -> Request RecordHandlerProgress
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy RecordHandlerProgress
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse RecordHandlerProgress)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"RecordHandlerProgressResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> RecordHandlerProgressResponse
RecordHandlerProgressResponse'
            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 RecordHandlerProgress where
  hashWithSalt :: Int -> RecordHandlerProgress -> Int
hashWithSalt Int
_salt RecordHandlerProgress' {Maybe Text
Maybe HandlerErrorCode
Maybe OperationStatus
Text
OperationStatus
operationStatus :: OperationStatus
bearerToken :: Text
statusMessage :: Maybe Text
resourceModel :: Maybe Text
errorCode :: Maybe HandlerErrorCode
currentOperationStatus :: Maybe OperationStatus
clientRequestToken :: Maybe Text
$sel:operationStatus:RecordHandlerProgress' :: RecordHandlerProgress -> OperationStatus
$sel:bearerToken:RecordHandlerProgress' :: RecordHandlerProgress -> Text
$sel:statusMessage:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
$sel:resourceModel:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
$sel:errorCode:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe HandlerErrorCode
$sel:currentOperationStatus:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe OperationStatus
$sel:clientRequestToken:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperationStatus
currentOperationStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HandlerErrorCode
errorCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceModel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
bearerToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` OperationStatus
operationStatus

instance Prelude.NFData RecordHandlerProgress where
  rnf :: RecordHandlerProgress -> ()
rnf RecordHandlerProgress' {Maybe Text
Maybe HandlerErrorCode
Maybe OperationStatus
Text
OperationStatus
operationStatus :: OperationStatus
bearerToken :: Text
statusMessage :: Maybe Text
resourceModel :: Maybe Text
errorCode :: Maybe HandlerErrorCode
currentOperationStatus :: Maybe OperationStatus
clientRequestToken :: Maybe Text
$sel:operationStatus:RecordHandlerProgress' :: RecordHandlerProgress -> OperationStatus
$sel:bearerToken:RecordHandlerProgress' :: RecordHandlerProgress -> Text
$sel:statusMessage:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
$sel:resourceModel:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
$sel:errorCode:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe HandlerErrorCode
$sel:currentOperationStatus:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe OperationStatus
$sel:clientRequestToken:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OperationStatus
currentOperationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe HandlerErrorCode
errorCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceModel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
bearerToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf OperationStatus
operationStatus

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

instance Data.ToPath RecordHandlerProgress where
  toPath :: RecordHandlerProgress -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery RecordHandlerProgress where
  toQuery :: RecordHandlerProgress -> QueryString
toQuery RecordHandlerProgress' {Maybe Text
Maybe HandlerErrorCode
Maybe OperationStatus
Text
OperationStatus
operationStatus :: OperationStatus
bearerToken :: Text
statusMessage :: Maybe Text
resourceModel :: Maybe Text
errorCode :: Maybe HandlerErrorCode
currentOperationStatus :: Maybe OperationStatus
clientRequestToken :: Maybe Text
$sel:operationStatus:RecordHandlerProgress' :: RecordHandlerProgress -> OperationStatus
$sel:bearerToken:RecordHandlerProgress' :: RecordHandlerProgress -> Text
$sel:statusMessage:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
$sel:resourceModel:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
$sel:errorCode:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe HandlerErrorCode
$sel:currentOperationStatus:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe OperationStatus
$sel:clientRequestToken:RecordHandlerProgress' :: RecordHandlerProgress -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"RecordHandlerProgress" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"ClientRequestToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientRequestToken,
        ByteString
"CurrentOperationStatus"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe OperationStatus
currentOperationStatus,
        ByteString
"ErrorCode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe HandlerErrorCode
errorCode,
        ByteString
"ResourceModel" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
resourceModel,
        ByteString
"StatusMessage" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
statusMessage,
        ByteString
"BearerToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
bearerToken,
        ByteString
"OperationStatus" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: OperationStatus
operationStatus
      ]

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

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

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

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