{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.CloudControl.Types.ProgressEvent
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.CloudControl.Types.ProgressEvent where

import Amazonka.CloudControl.Types.HandlerErrorCode
import Amazonka.CloudControl.Types.Operation
import Amazonka.CloudControl.Types.OperationStatus
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

-- | Represents the current status of a resource operation request. For more
-- information, see
-- <https://docs.aws.amazon.com/cloudcontrolapi/latest/userguide/resource-operations-manage-requests.html Managing resource operation requests>
-- in the /Amazon Web Services Cloud Control API User Guide/.
--
-- /See:/ 'newProgressEvent' smart constructor.
data ProgressEvent = ProgressEvent'
  { -- | For requests with a status of @FAILED@, the associated error code.
    --
    -- For error code definitions, see
    -- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-test-contract-errors.html Handler error codes>
    -- in the /CloudFormation Command Line Interface User Guide for Extension
    -- Development/.
    ProgressEvent -> Maybe HandlerErrorCode
errorCode :: Prelude.Maybe HandlerErrorCode,
    -- | When the resource operation request was initiated.
    ProgressEvent -> Maybe POSIX
eventTime :: Prelude.Maybe Data.POSIX,
    -- | The primary identifier for the resource.
    --
    -- In some cases, the resource identifier may be available before the
    -- resource operation has reached a status of @SUCCESS@.
    ProgressEvent -> Maybe Text
identifier :: Prelude.Maybe Prelude.Text,
    -- | The resource operation type.
    ProgressEvent -> Maybe Operation
operation :: Prelude.Maybe Operation,
    -- | The current status of the resource operation request.
    --
    -- -   @PENDING@: The resource operation hasn\'t yet started.
    --
    -- -   @IN_PROGRESS@: The resource operation is currently in progress.
    --
    -- -   @SUCCESS@: The resource operation has successfully completed.
    --
    -- -   @FAILED@: The resource operation has failed. Refer to the error code
    --     and status message for more information.
    --
    -- -   @CANCEL_IN_PROGRESS@: The resource operation is in the process of
    --     being canceled.
    --
    -- -   @CANCEL_COMPLETE@: The resource operation has been canceled.
    ProgressEvent -> Maybe OperationStatus
operationStatus :: Prelude.Maybe OperationStatus,
    -- | The unique token representing this resource operation request.
    --
    -- Use the @RequestToken@ with
    -- <https://docs.aws.amazon.com/cloudcontrolapi/latest/APIReference/API_GetResourceRequestStatus.html GetResourceRequestStatus>
    -- to return the current status of a resource operation request.
    ProgressEvent -> Maybe Text
requestToken :: Prelude.Maybe Prelude.Text,
    -- | A JSON string containing the resource model, consisting of each resource
    -- property and its current value.
    ProgressEvent -> Maybe (Sensitive Text)
resourceModel :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | When to next request the status of this resource operation request.
    ProgressEvent -> Maybe POSIX
retryAfter :: Prelude.Maybe Data.POSIX,
    -- | Any message explaining the current status.
    ProgressEvent -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | The name of the resource type used in the operation.
    ProgressEvent -> Maybe Text
typeName :: Prelude.Maybe Prelude.Text
  }
  deriving (ProgressEvent -> ProgressEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProgressEvent -> ProgressEvent -> Bool
$c/= :: ProgressEvent -> ProgressEvent -> Bool
== :: ProgressEvent -> ProgressEvent -> Bool
$c== :: ProgressEvent -> ProgressEvent -> Bool
Prelude.Eq, Int -> ProgressEvent -> ShowS
[ProgressEvent] -> ShowS
ProgressEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProgressEvent] -> ShowS
$cshowList :: [ProgressEvent] -> ShowS
show :: ProgressEvent -> String
$cshow :: ProgressEvent -> String
showsPrec :: Int -> ProgressEvent -> ShowS
$cshowsPrec :: Int -> ProgressEvent -> ShowS
Prelude.Show, forall x. Rep ProgressEvent x -> ProgressEvent
forall x. ProgressEvent -> Rep ProgressEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProgressEvent x -> ProgressEvent
$cfrom :: forall x. ProgressEvent -> Rep ProgressEvent x
Prelude.Generic)

-- |
-- Create a value of 'ProgressEvent' 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:
--
-- 'errorCode', 'progressEvent_errorCode' - For requests with a status of @FAILED@, the associated error code.
--
-- For error code definitions, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-test-contract-errors.html Handler error codes>
-- in the /CloudFormation Command Line Interface User Guide for Extension
-- Development/.
--
-- 'eventTime', 'progressEvent_eventTime' - When the resource operation request was initiated.
--
-- 'identifier', 'progressEvent_identifier' - The primary identifier for the resource.
--
-- In some cases, the resource identifier may be available before the
-- resource operation has reached a status of @SUCCESS@.
--
-- 'operation', 'progressEvent_operation' - The resource operation type.
--
-- 'operationStatus', 'progressEvent_operationStatus' - The current status of the resource operation request.
--
-- -   @PENDING@: The resource operation hasn\'t yet started.
--
-- -   @IN_PROGRESS@: The resource operation is currently in progress.
--
-- -   @SUCCESS@: The resource operation has successfully completed.
--
-- -   @FAILED@: The resource operation has failed. Refer to the error code
--     and status message for more information.
--
-- -   @CANCEL_IN_PROGRESS@: The resource operation is in the process of
--     being canceled.
--
-- -   @CANCEL_COMPLETE@: The resource operation has been canceled.
--
-- 'requestToken', 'progressEvent_requestToken' - The unique token representing this resource operation request.
--
-- Use the @RequestToken@ with
-- <https://docs.aws.amazon.com/cloudcontrolapi/latest/APIReference/API_GetResourceRequestStatus.html GetResourceRequestStatus>
-- to return the current status of a resource operation request.
--
-- 'resourceModel', 'progressEvent_resourceModel' - A JSON string containing the resource model, consisting of each resource
-- property and its current value.
--
-- 'retryAfter', 'progressEvent_retryAfter' - When to next request the status of this resource operation request.
--
-- 'statusMessage', 'progressEvent_statusMessage' - Any message explaining the current status.
--
-- 'typeName', 'progressEvent_typeName' - The name of the resource type used in the operation.
newProgressEvent ::
  ProgressEvent
newProgressEvent :: ProgressEvent
newProgressEvent =
  ProgressEvent'
    { $sel:errorCode:ProgressEvent' :: Maybe HandlerErrorCode
errorCode = forall a. Maybe a
Prelude.Nothing,
      $sel:eventTime:ProgressEvent' :: Maybe POSIX
eventTime = forall a. Maybe a
Prelude.Nothing,
      $sel:identifier:ProgressEvent' :: Maybe Text
identifier = forall a. Maybe a
Prelude.Nothing,
      $sel:operation:ProgressEvent' :: Maybe Operation
operation = forall a. Maybe a
Prelude.Nothing,
      $sel:operationStatus:ProgressEvent' :: Maybe OperationStatus
operationStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:requestToken:ProgressEvent' :: Maybe Text
requestToken = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceModel:ProgressEvent' :: Maybe (Sensitive Text)
resourceModel = forall a. Maybe a
Prelude.Nothing,
      $sel:retryAfter:ProgressEvent' :: Maybe POSIX
retryAfter = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:ProgressEvent' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:typeName:ProgressEvent' :: Maybe Text
typeName = forall a. Maybe a
Prelude.Nothing
    }

-- | For requests with a status of @FAILED@, the associated error code.
--
-- For error code definitions, see
-- <https://docs.aws.amazon.com/cloudformation-cli/latest/userguide/resource-type-test-contract-errors.html Handler error codes>
-- in the /CloudFormation Command Line Interface User Guide for Extension
-- Development/.
progressEvent_errorCode :: Lens.Lens' ProgressEvent (Prelude.Maybe HandlerErrorCode)
progressEvent_errorCode :: Lens' ProgressEvent (Maybe HandlerErrorCode)
progressEvent_errorCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe HandlerErrorCode
errorCode :: Maybe HandlerErrorCode
$sel:errorCode:ProgressEvent' :: ProgressEvent -> Maybe HandlerErrorCode
errorCode} -> Maybe HandlerErrorCode
errorCode) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe HandlerErrorCode
a -> ProgressEvent
s {$sel:errorCode:ProgressEvent' :: Maybe HandlerErrorCode
errorCode = Maybe HandlerErrorCode
a} :: ProgressEvent)

-- | When the resource operation request was initiated.
progressEvent_eventTime :: Lens.Lens' ProgressEvent (Prelude.Maybe Prelude.UTCTime)
progressEvent_eventTime :: Lens' ProgressEvent (Maybe UTCTime)
progressEvent_eventTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe POSIX
eventTime :: Maybe POSIX
$sel:eventTime:ProgressEvent' :: ProgressEvent -> Maybe POSIX
eventTime} -> Maybe POSIX
eventTime) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe POSIX
a -> ProgressEvent
s {$sel:eventTime:ProgressEvent' :: Maybe POSIX
eventTime = Maybe POSIX
a} :: ProgressEvent) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The primary identifier for the resource.
--
-- In some cases, the resource identifier may be available before the
-- resource operation has reached a status of @SUCCESS@.
progressEvent_identifier :: Lens.Lens' ProgressEvent (Prelude.Maybe Prelude.Text)
progressEvent_identifier :: Lens' ProgressEvent (Maybe Text)
progressEvent_identifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe Text
identifier :: Maybe Text
$sel:identifier:ProgressEvent' :: ProgressEvent -> Maybe Text
identifier} -> Maybe Text
identifier) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe Text
a -> ProgressEvent
s {$sel:identifier:ProgressEvent' :: Maybe Text
identifier = Maybe Text
a} :: ProgressEvent)

-- | The resource operation type.
progressEvent_operation :: Lens.Lens' ProgressEvent (Prelude.Maybe Operation)
progressEvent_operation :: Lens' ProgressEvent (Maybe Operation)
progressEvent_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe Operation
operation :: Maybe Operation
$sel:operation:ProgressEvent' :: ProgressEvent -> Maybe Operation
operation} -> Maybe Operation
operation) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe Operation
a -> ProgressEvent
s {$sel:operation:ProgressEvent' :: Maybe Operation
operation = Maybe Operation
a} :: ProgressEvent)

-- | The current status of the resource operation request.
--
-- -   @PENDING@: The resource operation hasn\'t yet started.
--
-- -   @IN_PROGRESS@: The resource operation is currently in progress.
--
-- -   @SUCCESS@: The resource operation has successfully completed.
--
-- -   @FAILED@: The resource operation has failed. Refer to the error code
--     and status message for more information.
--
-- -   @CANCEL_IN_PROGRESS@: The resource operation is in the process of
--     being canceled.
--
-- -   @CANCEL_COMPLETE@: The resource operation has been canceled.
progressEvent_operationStatus :: Lens.Lens' ProgressEvent (Prelude.Maybe OperationStatus)
progressEvent_operationStatus :: Lens' ProgressEvent (Maybe OperationStatus)
progressEvent_operationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe OperationStatus
operationStatus :: Maybe OperationStatus
$sel:operationStatus:ProgressEvent' :: ProgressEvent -> Maybe OperationStatus
operationStatus} -> Maybe OperationStatus
operationStatus) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe OperationStatus
a -> ProgressEvent
s {$sel:operationStatus:ProgressEvent' :: Maybe OperationStatus
operationStatus = Maybe OperationStatus
a} :: ProgressEvent)

-- | The unique token representing this resource operation request.
--
-- Use the @RequestToken@ with
-- <https://docs.aws.amazon.com/cloudcontrolapi/latest/APIReference/API_GetResourceRequestStatus.html GetResourceRequestStatus>
-- to return the current status of a resource operation request.
progressEvent_requestToken :: Lens.Lens' ProgressEvent (Prelude.Maybe Prelude.Text)
progressEvent_requestToken :: Lens' ProgressEvent (Maybe Text)
progressEvent_requestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe Text
requestToken :: Maybe Text
$sel:requestToken:ProgressEvent' :: ProgressEvent -> Maybe Text
requestToken} -> Maybe Text
requestToken) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe Text
a -> ProgressEvent
s {$sel:requestToken:ProgressEvent' :: Maybe Text
requestToken = Maybe Text
a} :: ProgressEvent)

-- | A JSON string containing the resource model, consisting of each resource
-- property and its current value.
progressEvent_resourceModel :: Lens.Lens' ProgressEvent (Prelude.Maybe Prelude.Text)
progressEvent_resourceModel :: Lens' ProgressEvent (Maybe Text)
progressEvent_resourceModel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe (Sensitive Text)
resourceModel :: Maybe (Sensitive Text)
$sel:resourceModel:ProgressEvent' :: ProgressEvent -> Maybe (Sensitive Text)
resourceModel} -> Maybe (Sensitive Text)
resourceModel) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe (Sensitive Text)
a -> ProgressEvent
s {$sel:resourceModel:ProgressEvent' :: Maybe (Sensitive Text)
resourceModel = Maybe (Sensitive Text)
a} :: ProgressEvent) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | When to next request the status of this resource operation request.
progressEvent_retryAfter :: Lens.Lens' ProgressEvent (Prelude.Maybe Prelude.UTCTime)
progressEvent_retryAfter :: Lens' ProgressEvent (Maybe UTCTime)
progressEvent_retryAfter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe POSIX
retryAfter :: Maybe POSIX
$sel:retryAfter:ProgressEvent' :: ProgressEvent -> Maybe POSIX
retryAfter} -> Maybe POSIX
retryAfter) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe POSIX
a -> ProgressEvent
s {$sel:retryAfter:ProgressEvent' :: Maybe POSIX
retryAfter = Maybe POSIX
a} :: ProgressEvent) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Any message explaining the current status.
progressEvent_statusMessage :: Lens.Lens' ProgressEvent (Prelude.Maybe Prelude.Text)
progressEvent_statusMessage :: Lens' ProgressEvent (Maybe Text)
progressEvent_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:ProgressEvent' :: ProgressEvent -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe Text
a -> ProgressEvent
s {$sel:statusMessage:ProgressEvent' :: Maybe Text
statusMessage = Maybe Text
a} :: ProgressEvent)

-- | The name of the resource type used in the operation.
progressEvent_typeName :: Lens.Lens' ProgressEvent (Prelude.Maybe Prelude.Text)
progressEvent_typeName :: Lens' ProgressEvent (Maybe Text)
progressEvent_typeName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ProgressEvent' {Maybe Text
typeName :: Maybe Text
$sel:typeName:ProgressEvent' :: ProgressEvent -> Maybe Text
typeName} -> Maybe Text
typeName) (\s :: ProgressEvent
s@ProgressEvent' {} Maybe Text
a -> ProgressEvent
s {$sel:typeName:ProgressEvent' :: Maybe Text
typeName = Maybe Text
a} :: ProgressEvent)

instance Data.FromJSON ProgressEvent where
  parseJSON :: Value -> Parser ProgressEvent
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ProgressEvent"
      ( \Object
x ->
          Maybe HandlerErrorCode
-> Maybe POSIX
-> Maybe Text
-> Maybe Operation
-> Maybe OperationStatus
-> Maybe Text
-> Maybe (Sensitive Text)
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> ProgressEvent
ProgressEvent'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ErrorCode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"EventTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Identifier")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Operation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"OperationStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RequestToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"ResourceModel")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"RetryAfter")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StatusMessage")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"TypeName")
      )

instance Prelude.Hashable ProgressEvent where
  hashWithSalt :: Int -> ProgressEvent -> Int
hashWithSalt Int
_salt ProgressEvent' {Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe HandlerErrorCode
Maybe Operation
Maybe OperationStatus
typeName :: Maybe Text
statusMessage :: Maybe Text
retryAfter :: Maybe POSIX
resourceModel :: Maybe (Sensitive Text)
requestToken :: Maybe Text
operationStatus :: Maybe OperationStatus
operation :: Maybe Operation
identifier :: Maybe Text
eventTime :: Maybe POSIX
errorCode :: Maybe HandlerErrorCode
$sel:typeName:ProgressEvent' :: ProgressEvent -> Maybe Text
$sel:statusMessage:ProgressEvent' :: ProgressEvent -> Maybe Text
$sel:retryAfter:ProgressEvent' :: ProgressEvent -> Maybe POSIX
$sel:resourceModel:ProgressEvent' :: ProgressEvent -> Maybe (Sensitive Text)
$sel:requestToken:ProgressEvent' :: ProgressEvent -> Maybe Text
$sel:operationStatus:ProgressEvent' :: ProgressEvent -> Maybe OperationStatus
$sel:operation:ProgressEvent' :: ProgressEvent -> Maybe Operation
$sel:identifier:ProgressEvent' :: ProgressEvent -> Maybe Text
$sel:eventTime:ProgressEvent' :: ProgressEvent -> Maybe POSIX
$sel:errorCode:ProgressEvent' :: ProgressEvent -> Maybe HandlerErrorCode
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe HandlerErrorCode
errorCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
eventTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
identifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Operation
operation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OperationStatus
operationStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
requestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
resourceModel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
retryAfter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
typeName

instance Prelude.NFData ProgressEvent where
  rnf :: ProgressEvent -> ()
rnf ProgressEvent' {Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe HandlerErrorCode
Maybe Operation
Maybe OperationStatus
typeName :: Maybe Text
statusMessage :: Maybe Text
retryAfter :: Maybe POSIX
resourceModel :: Maybe (Sensitive Text)
requestToken :: Maybe Text
operationStatus :: Maybe OperationStatus
operation :: Maybe Operation
identifier :: Maybe Text
eventTime :: Maybe POSIX
errorCode :: Maybe HandlerErrorCode
$sel:typeName:ProgressEvent' :: ProgressEvent -> Maybe Text
$sel:statusMessage:ProgressEvent' :: ProgressEvent -> Maybe Text
$sel:retryAfter:ProgressEvent' :: ProgressEvent -> Maybe POSIX
$sel:resourceModel:ProgressEvent' :: ProgressEvent -> Maybe (Sensitive Text)
$sel:requestToken:ProgressEvent' :: ProgressEvent -> Maybe Text
$sel:operationStatus:ProgressEvent' :: ProgressEvent -> Maybe OperationStatus
$sel:operation:ProgressEvent' :: ProgressEvent -> Maybe Operation
$sel:identifier:ProgressEvent' :: ProgressEvent -> Maybe Text
$sel:eventTime:ProgressEvent' :: ProgressEvent -> Maybe POSIX
$sel:errorCode:ProgressEvent' :: ProgressEvent -> Maybe HandlerErrorCode
..} =
    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 POSIX
eventTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
identifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Operation
operation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OperationStatus
operationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
resourceModel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
retryAfter
      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 Maybe Text
typeName