{-# 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.AppConfig.Types.DeploymentEvent
-- 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.AppConfig.Types.DeploymentEvent where

import Amazonka.AppConfig.Types.ActionInvocation
import Amazonka.AppConfig.Types.DeploymentEventType
import Amazonka.AppConfig.Types.TriggeredBy
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

-- | An object that describes a deployment event.
--
-- /See:/ 'newDeploymentEvent' smart constructor.
data DeploymentEvent = DeploymentEvent'
  { -- | The list of extensions that were invoked as part of the deployment.
    DeploymentEvent -> Maybe [ActionInvocation]
actionInvocations :: Prelude.Maybe [ActionInvocation],
    -- | A description of the deployment event. Descriptions include, but are not
    -- limited to, the user account or the Amazon CloudWatch alarm ARN that
    -- initiated a rollback, the percentage of hosts that received the
    -- deployment, or in the case of an internal error, a recommendation to
    -- attempt a new deployment.
    DeploymentEvent -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The type of deployment event. Deployment event types include the start,
    -- stop, or completion of a deployment; a percentage update; the start or
    -- stop of a bake period; and the start or completion of a rollback.
    DeploymentEvent -> Maybe DeploymentEventType
eventType :: Prelude.Maybe DeploymentEventType,
    -- | The date and time the event occurred.
    DeploymentEvent -> Maybe ISO8601
occurredAt :: Prelude.Maybe Data.ISO8601,
    -- | The entity that triggered the deployment event. Events can be triggered
    -- by a user, AppConfig, an Amazon CloudWatch alarm, or an internal error.
    DeploymentEvent -> Maybe TriggeredBy
triggeredBy :: Prelude.Maybe TriggeredBy
  }
  deriving (DeploymentEvent -> DeploymentEvent -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeploymentEvent -> DeploymentEvent -> Bool
$c/= :: DeploymentEvent -> DeploymentEvent -> Bool
== :: DeploymentEvent -> DeploymentEvent -> Bool
$c== :: DeploymentEvent -> DeploymentEvent -> Bool
Prelude.Eq, ReadPrec [DeploymentEvent]
ReadPrec DeploymentEvent
Int -> ReadS DeploymentEvent
ReadS [DeploymentEvent]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeploymentEvent]
$creadListPrec :: ReadPrec [DeploymentEvent]
readPrec :: ReadPrec DeploymentEvent
$creadPrec :: ReadPrec DeploymentEvent
readList :: ReadS [DeploymentEvent]
$creadList :: ReadS [DeploymentEvent]
readsPrec :: Int -> ReadS DeploymentEvent
$creadsPrec :: Int -> ReadS DeploymentEvent
Prelude.Read, Int -> DeploymentEvent -> ShowS
[DeploymentEvent] -> ShowS
DeploymentEvent -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeploymentEvent] -> ShowS
$cshowList :: [DeploymentEvent] -> ShowS
show :: DeploymentEvent -> String
$cshow :: DeploymentEvent -> String
showsPrec :: Int -> DeploymentEvent -> ShowS
$cshowsPrec :: Int -> DeploymentEvent -> ShowS
Prelude.Show, forall x. Rep DeploymentEvent x -> DeploymentEvent
forall x. DeploymentEvent -> Rep DeploymentEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeploymentEvent x -> DeploymentEvent
$cfrom :: forall x. DeploymentEvent -> Rep DeploymentEvent x
Prelude.Generic)

-- |
-- Create a value of 'DeploymentEvent' 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:
--
-- 'actionInvocations', 'deploymentEvent_actionInvocations' - The list of extensions that were invoked as part of the deployment.
--
-- 'description', 'deploymentEvent_description' - A description of the deployment event. Descriptions include, but are not
-- limited to, the user account or the Amazon CloudWatch alarm ARN that
-- initiated a rollback, the percentage of hosts that received the
-- deployment, or in the case of an internal error, a recommendation to
-- attempt a new deployment.
--
-- 'eventType', 'deploymentEvent_eventType' - The type of deployment event. Deployment event types include the start,
-- stop, or completion of a deployment; a percentage update; the start or
-- stop of a bake period; and the start or completion of a rollback.
--
-- 'occurredAt', 'deploymentEvent_occurredAt' - The date and time the event occurred.
--
-- 'triggeredBy', 'deploymentEvent_triggeredBy' - The entity that triggered the deployment event. Events can be triggered
-- by a user, AppConfig, an Amazon CloudWatch alarm, or an internal error.
newDeploymentEvent ::
  DeploymentEvent
newDeploymentEvent :: DeploymentEvent
newDeploymentEvent =
  DeploymentEvent'
    { $sel:actionInvocations:DeploymentEvent' :: Maybe [ActionInvocation]
actionInvocations =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:DeploymentEvent' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:eventType:DeploymentEvent' :: Maybe DeploymentEventType
eventType = forall a. Maybe a
Prelude.Nothing,
      $sel:occurredAt:DeploymentEvent' :: Maybe ISO8601
occurredAt = forall a. Maybe a
Prelude.Nothing,
      $sel:triggeredBy:DeploymentEvent' :: Maybe TriggeredBy
triggeredBy = forall a. Maybe a
Prelude.Nothing
    }

-- | The list of extensions that were invoked as part of the deployment.
deploymentEvent_actionInvocations :: Lens.Lens' DeploymentEvent (Prelude.Maybe [ActionInvocation])
deploymentEvent_actionInvocations :: Lens' DeploymentEvent (Maybe [ActionInvocation])
deploymentEvent_actionInvocations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentEvent' {Maybe [ActionInvocation]
actionInvocations :: Maybe [ActionInvocation]
$sel:actionInvocations:DeploymentEvent' :: DeploymentEvent -> Maybe [ActionInvocation]
actionInvocations} -> Maybe [ActionInvocation]
actionInvocations) (\s :: DeploymentEvent
s@DeploymentEvent' {} Maybe [ActionInvocation]
a -> DeploymentEvent
s {$sel:actionInvocations:DeploymentEvent' :: Maybe [ActionInvocation]
actionInvocations = Maybe [ActionInvocation]
a} :: DeploymentEvent) 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

-- | A description of the deployment event. Descriptions include, but are not
-- limited to, the user account or the Amazon CloudWatch alarm ARN that
-- initiated a rollback, the percentage of hosts that received the
-- deployment, or in the case of an internal error, a recommendation to
-- attempt a new deployment.
deploymentEvent_description :: Lens.Lens' DeploymentEvent (Prelude.Maybe Prelude.Text)
deploymentEvent_description :: Lens' DeploymentEvent (Maybe Text)
deploymentEvent_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentEvent' {Maybe Text
description :: Maybe Text
$sel:description:DeploymentEvent' :: DeploymentEvent -> Maybe Text
description} -> Maybe Text
description) (\s :: DeploymentEvent
s@DeploymentEvent' {} Maybe Text
a -> DeploymentEvent
s {$sel:description:DeploymentEvent' :: Maybe Text
description = Maybe Text
a} :: DeploymentEvent)

-- | The type of deployment event. Deployment event types include the start,
-- stop, or completion of a deployment; a percentage update; the start or
-- stop of a bake period; and the start or completion of a rollback.
deploymentEvent_eventType :: Lens.Lens' DeploymentEvent (Prelude.Maybe DeploymentEventType)
deploymentEvent_eventType :: Lens' DeploymentEvent (Maybe DeploymentEventType)
deploymentEvent_eventType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentEvent' {Maybe DeploymentEventType
eventType :: Maybe DeploymentEventType
$sel:eventType:DeploymentEvent' :: DeploymentEvent -> Maybe DeploymentEventType
eventType} -> Maybe DeploymentEventType
eventType) (\s :: DeploymentEvent
s@DeploymentEvent' {} Maybe DeploymentEventType
a -> DeploymentEvent
s {$sel:eventType:DeploymentEvent' :: Maybe DeploymentEventType
eventType = Maybe DeploymentEventType
a} :: DeploymentEvent)

-- | The date and time the event occurred.
deploymentEvent_occurredAt :: Lens.Lens' DeploymentEvent (Prelude.Maybe Prelude.UTCTime)
deploymentEvent_occurredAt :: Lens' DeploymentEvent (Maybe UTCTime)
deploymentEvent_occurredAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentEvent' {Maybe ISO8601
occurredAt :: Maybe ISO8601
$sel:occurredAt:DeploymentEvent' :: DeploymentEvent -> Maybe ISO8601
occurredAt} -> Maybe ISO8601
occurredAt) (\s :: DeploymentEvent
s@DeploymentEvent' {} Maybe ISO8601
a -> DeploymentEvent
s {$sel:occurredAt:DeploymentEvent' :: Maybe ISO8601
occurredAt = Maybe ISO8601
a} :: DeploymentEvent) 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 entity that triggered the deployment event. Events can be triggered
-- by a user, AppConfig, an Amazon CloudWatch alarm, or an internal error.
deploymentEvent_triggeredBy :: Lens.Lens' DeploymentEvent (Prelude.Maybe TriggeredBy)
deploymentEvent_triggeredBy :: Lens' DeploymentEvent (Maybe TriggeredBy)
deploymentEvent_triggeredBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeploymentEvent' {Maybe TriggeredBy
triggeredBy :: Maybe TriggeredBy
$sel:triggeredBy:DeploymentEvent' :: DeploymentEvent -> Maybe TriggeredBy
triggeredBy} -> Maybe TriggeredBy
triggeredBy) (\s :: DeploymentEvent
s@DeploymentEvent' {} Maybe TriggeredBy
a -> DeploymentEvent
s {$sel:triggeredBy:DeploymentEvent' :: Maybe TriggeredBy
triggeredBy = Maybe TriggeredBy
a} :: DeploymentEvent)

instance Data.FromJSON DeploymentEvent where
  parseJSON :: Value -> Parser DeploymentEvent
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"DeploymentEvent"
      ( \Object
x ->
          Maybe [ActionInvocation]
-> Maybe Text
-> Maybe DeploymentEventType
-> Maybe ISO8601
-> Maybe TriggeredBy
-> DeploymentEvent
DeploymentEvent'
            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
"ActionInvocations"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            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
"Description")
            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
"EventType")
            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
"OccurredAt")
            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
"TriggeredBy")
      )

instance Prelude.Hashable DeploymentEvent where
  hashWithSalt :: Int -> DeploymentEvent -> Int
hashWithSalt Int
_salt DeploymentEvent' {Maybe [ActionInvocation]
Maybe Text
Maybe ISO8601
Maybe DeploymentEventType
Maybe TriggeredBy
triggeredBy :: Maybe TriggeredBy
occurredAt :: Maybe ISO8601
eventType :: Maybe DeploymentEventType
description :: Maybe Text
actionInvocations :: Maybe [ActionInvocation]
$sel:triggeredBy:DeploymentEvent' :: DeploymentEvent -> Maybe TriggeredBy
$sel:occurredAt:DeploymentEvent' :: DeploymentEvent -> Maybe ISO8601
$sel:eventType:DeploymentEvent' :: DeploymentEvent -> Maybe DeploymentEventType
$sel:description:DeploymentEvent' :: DeploymentEvent -> Maybe Text
$sel:actionInvocations:DeploymentEvent' :: DeploymentEvent -> Maybe [ActionInvocation]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ActionInvocation]
actionInvocations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DeploymentEventType
eventType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
occurredAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TriggeredBy
triggeredBy

instance Prelude.NFData DeploymentEvent where
  rnf :: DeploymentEvent -> ()
rnf DeploymentEvent' {Maybe [ActionInvocation]
Maybe Text
Maybe ISO8601
Maybe DeploymentEventType
Maybe TriggeredBy
triggeredBy :: Maybe TriggeredBy
occurredAt :: Maybe ISO8601
eventType :: Maybe DeploymentEventType
description :: Maybe Text
actionInvocations :: Maybe [ActionInvocation]
$sel:triggeredBy:DeploymentEvent' :: DeploymentEvent -> Maybe TriggeredBy
$sel:occurredAt:DeploymentEvent' :: DeploymentEvent -> Maybe ISO8601
$sel:eventType:DeploymentEvent' :: DeploymentEvent -> Maybe DeploymentEventType
$sel:description:DeploymentEvent' :: DeploymentEvent -> Maybe Text
$sel:actionInvocations:DeploymentEvent' :: DeploymentEvent -> Maybe [ActionInvocation]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ActionInvocation]
actionInvocations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DeploymentEventType
eventType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
occurredAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TriggeredBy
triggeredBy