{-# 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.Synthetics.Types.Canary
-- 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.Synthetics.Types.Canary 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 Amazonka.Synthetics.Types.ArtifactConfigOutput
import Amazonka.Synthetics.Types.CanaryCodeOutput
import Amazonka.Synthetics.Types.CanaryRunConfigOutput
import Amazonka.Synthetics.Types.CanaryScheduleOutput
import Amazonka.Synthetics.Types.CanaryStatus
import Amazonka.Synthetics.Types.CanaryTimeline
import Amazonka.Synthetics.Types.VisualReferenceOutput
import Amazonka.Synthetics.Types.VpcConfigOutput

-- | This structure contains all information about one canary in your
-- account.
--
-- /See:/ 'newCanary' smart constructor.
data Canary = Canary'
  { -- | A structure that contains the configuration for canary artifacts,
    -- including the encryption-at-rest settings for artifacts that the canary
    -- uploads to Amazon S3.
    Canary -> Maybe ArtifactConfigOutput
artifactConfig :: Prelude.Maybe ArtifactConfigOutput,
    -- | The location in Amazon S3 where Synthetics stores artifacts from the
    -- runs of this canary. Artifacts include the log file, screenshots, and
    -- HAR files.
    Canary -> Maybe Text
artifactS3Location :: Prelude.Maybe Prelude.Text,
    Canary -> Maybe CanaryCodeOutput
code :: Prelude.Maybe CanaryCodeOutput,
    -- | The ARN of the Lambda function that is used as your canary\'s engine.
    -- For more information about Lambda ARN format, see
    -- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-api-permissions-ref.html Resources and Conditions for Lambda Actions>.
    Canary -> Maybe Text
engineArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the IAM role used to run the canary. This role must include
    -- @lambda.amazonaws.com@ as a principal in the trust policy.
    Canary -> Maybe Text
executionRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The number of days to retain data about failed runs of this canary.
    Canary -> Maybe Natural
failureRetentionPeriodInDays :: Prelude.Maybe Prelude.Natural,
    -- | The unique ID of this canary.
    Canary -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The name of the canary.
    Canary -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    Canary -> Maybe CanaryRunConfigOutput
runConfig :: Prelude.Maybe CanaryRunConfigOutput,
    -- | Specifies the runtime version to use for the canary. For more
    -- information about runtime versions, see
    -- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch_Synthetics_Canaries_Library.html Canary Runtime Versions>.
    Canary -> Maybe Text
runtimeVersion :: Prelude.Maybe Prelude.Text,
    -- | A structure that contains information about how often the canary is to
    -- run, and when these runs are to stop.
    Canary -> Maybe CanaryScheduleOutput
schedule :: Prelude.Maybe CanaryScheduleOutput,
    -- | A structure that contains information about the canary\'s status.
    Canary -> Maybe CanaryStatus
status :: Prelude.Maybe CanaryStatus,
    -- | The number of days to retain data about successful runs of this canary.
    Canary -> Maybe Natural
successRetentionPeriodInDays :: Prelude.Maybe Prelude.Natural,
    -- | The list of key-value pairs that are associated with the canary.
    Canary -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A structure that contains information about when the canary was created,
    -- modified, and most recently run.
    Canary -> Maybe CanaryTimeline
timeline :: Prelude.Maybe CanaryTimeline,
    -- | If this canary performs visual monitoring by comparing screenshots, this
    -- structure contains the ID of the canary run to use as the baseline for
    -- screenshots, and the coordinates of any parts of the screen to ignore
    -- during the visual monitoring comparison.
    Canary -> Maybe VisualReferenceOutput
visualReference :: Prelude.Maybe VisualReferenceOutput,
    Canary -> Maybe VpcConfigOutput
vpcConfig :: Prelude.Maybe VpcConfigOutput
  }
  deriving (Canary -> Canary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Canary -> Canary -> Bool
$c/= :: Canary -> Canary -> Bool
== :: Canary -> Canary -> Bool
$c== :: Canary -> Canary -> Bool
Prelude.Eq, ReadPrec [Canary]
ReadPrec Canary
Int -> ReadS Canary
ReadS [Canary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Canary]
$creadListPrec :: ReadPrec [Canary]
readPrec :: ReadPrec Canary
$creadPrec :: ReadPrec Canary
readList :: ReadS [Canary]
$creadList :: ReadS [Canary]
readsPrec :: Int -> ReadS Canary
$creadsPrec :: Int -> ReadS Canary
Prelude.Read, Int -> Canary -> ShowS
[Canary] -> ShowS
Canary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Canary] -> ShowS
$cshowList :: [Canary] -> ShowS
show :: Canary -> String
$cshow :: Canary -> String
showsPrec :: Int -> Canary -> ShowS
$cshowsPrec :: Int -> Canary -> ShowS
Prelude.Show, forall x. Rep Canary x -> Canary
forall x. Canary -> Rep Canary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Canary x -> Canary
$cfrom :: forall x. Canary -> Rep Canary x
Prelude.Generic)

-- |
-- Create a value of 'Canary' 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:
--
-- 'artifactConfig', 'canary_artifactConfig' - A structure that contains the configuration for canary artifacts,
-- including the encryption-at-rest settings for artifacts that the canary
-- uploads to Amazon S3.
--
-- 'artifactS3Location', 'canary_artifactS3Location' - The location in Amazon S3 where Synthetics stores artifacts from the
-- runs of this canary. Artifacts include the log file, screenshots, and
-- HAR files.
--
-- 'code', 'canary_code' - Undocumented member.
--
-- 'engineArn', 'canary_engineArn' - The ARN of the Lambda function that is used as your canary\'s engine.
-- For more information about Lambda ARN format, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-api-permissions-ref.html Resources and Conditions for Lambda Actions>.
--
-- 'executionRoleArn', 'canary_executionRoleArn' - The ARN of the IAM role used to run the canary. This role must include
-- @lambda.amazonaws.com@ as a principal in the trust policy.
--
-- 'failureRetentionPeriodInDays', 'canary_failureRetentionPeriodInDays' - The number of days to retain data about failed runs of this canary.
--
-- 'id', 'canary_id' - The unique ID of this canary.
--
-- 'name', 'canary_name' - The name of the canary.
--
-- 'runConfig', 'canary_runConfig' - Undocumented member.
--
-- 'runtimeVersion', 'canary_runtimeVersion' - Specifies the runtime version to use for the canary. For more
-- information about runtime versions, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch_Synthetics_Canaries_Library.html Canary Runtime Versions>.
--
-- 'schedule', 'canary_schedule' - A structure that contains information about how often the canary is to
-- run, and when these runs are to stop.
--
-- 'status', 'canary_status' - A structure that contains information about the canary\'s status.
--
-- 'successRetentionPeriodInDays', 'canary_successRetentionPeriodInDays' - The number of days to retain data about successful runs of this canary.
--
-- 'tags', 'canary_tags' - The list of key-value pairs that are associated with the canary.
--
-- 'timeline', 'canary_timeline' - A structure that contains information about when the canary was created,
-- modified, and most recently run.
--
-- 'visualReference', 'canary_visualReference' - If this canary performs visual monitoring by comparing screenshots, this
-- structure contains the ID of the canary run to use as the baseline for
-- screenshots, and the coordinates of any parts of the screen to ignore
-- during the visual monitoring comparison.
--
-- 'vpcConfig', 'canary_vpcConfig' - Undocumented member.
newCanary ::
  Canary
newCanary :: Canary
newCanary =
  Canary'
    { $sel:artifactConfig:Canary' :: Maybe ArtifactConfigOutput
artifactConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:artifactS3Location:Canary' :: Maybe Text
artifactS3Location = forall a. Maybe a
Prelude.Nothing,
      $sel:code:Canary' :: Maybe CanaryCodeOutput
code = forall a. Maybe a
Prelude.Nothing,
      $sel:engineArn:Canary' :: Maybe Text
engineArn = forall a. Maybe a
Prelude.Nothing,
      $sel:executionRoleArn:Canary' :: Maybe Text
executionRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:failureRetentionPeriodInDays:Canary' :: Maybe Natural
failureRetentionPeriodInDays = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Canary' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Canary' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:runConfig:Canary' :: Maybe CanaryRunConfigOutput
runConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:runtimeVersion:Canary' :: Maybe Text
runtimeVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:schedule:Canary' :: Maybe CanaryScheduleOutput
schedule = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Canary' :: Maybe CanaryStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:successRetentionPeriodInDays:Canary' :: Maybe Natural
successRetentionPeriodInDays = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Canary' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timeline:Canary' :: Maybe CanaryTimeline
timeline = forall a. Maybe a
Prelude.Nothing,
      $sel:visualReference:Canary' :: Maybe VisualReferenceOutput
visualReference = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcConfig:Canary' :: Maybe VpcConfigOutput
vpcConfig = forall a. Maybe a
Prelude.Nothing
    }

-- | A structure that contains the configuration for canary artifacts,
-- including the encryption-at-rest settings for artifacts that the canary
-- uploads to Amazon S3.
canary_artifactConfig :: Lens.Lens' Canary (Prelude.Maybe ArtifactConfigOutput)
canary_artifactConfig :: Lens' Canary (Maybe ArtifactConfigOutput)
canary_artifactConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe ArtifactConfigOutput
artifactConfig :: Maybe ArtifactConfigOutput
$sel:artifactConfig:Canary' :: Canary -> Maybe ArtifactConfigOutput
artifactConfig} -> Maybe ArtifactConfigOutput
artifactConfig) (\s :: Canary
s@Canary' {} Maybe ArtifactConfigOutput
a -> Canary
s {$sel:artifactConfig:Canary' :: Maybe ArtifactConfigOutput
artifactConfig = Maybe ArtifactConfigOutput
a} :: Canary)

-- | The location in Amazon S3 where Synthetics stores artifacts from the
-- runs of this canary. Artifacts include the log file, screenshots, and
-- HAR files.
canary_artifactS3Location :: Lens.Lens' Canary (Prelude.Maybe Prelude.Text)
canary_artifactS3Location :: Lens' Canary (Maybe Text)
canary_artifactS3Location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe Text
artifactS3Location :: Maybe Text
$sel:artifactS3Location:Canary' :: Canary -> Maybe Text
artifactS3Location} -> Maybe Text
artifactS3Location) (\s :: Canary
s@Canary' {} Maybe Text
a -> Canary
s {$sel:artifactS3Location:Canary' :: Maybe Text
artifactS3Location = Maybe Text
a} :: Canary)

-- | Undocumented member.
canary_code :: Lens.Lens' Canary (Prelude.Maybe CanaryCodeOutput)
canary_code :: Lens' Canary (Maybe CanaryCodeOutput)
canary_code = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe CanaryCodeOutput
code :: Maybe CanaryCodeOutput
$sel:code:Canary' :: Canary -> Maybe CanaryCodeOutput
code} -> Maybe CanaryCodeOutput
code) (\s :: Canary
s@Canary' {} Maybe CanaryCodeOutput
a -> Canary
s {$sel:code:Canary' :: Maybe CanaryCodeOutput
code = Maybe CanaryCodeOutput
a} :: Canary)

-- | The ARN of the Lambda function that is used as your canary\'s engine.
-- For more information about Lambda ARN format, see
-- <https://docs.aws.amazon.com/lambda/latest/dg/lambda-api-permissions-ref.html Resources and Conditions for Lambda Actions>.
canary_engineArn :: Lens.Lens' Canary (Prelude.Maybe Prelude.Text)
canary_engineArn :: Lens' Canary (Maybe Text)
canary_engineArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe Text
engineArn :: Maybe Text
$sel:engineArn:Canary' :: Canary -> Maybe Text
engineArn} -> Maybe Text
engineArn) (\s :: Canary
s@Canary' {} Maybe Text
a -> Canary
s {$sel:engineArn:Canary' :: Maybe Text
engineArn = Maybe Text
a} :: Canary)

-- | The ARN of the IAM role used to run the canary. This role must include
-- @lambda.amazonaws.com@ as a principal in the trust policy.
canary_executionRoleArn :: Lens.Lens' Canary (Prelude.Maybe Prelude.Text)
canary_executionRoleArn :: Lens' Canary (Maybe Text)
canary_executionRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe Text
executionRoleArn :: Maybe Text
$sel:executionRoleArn:Canary' :: Canary -> Maybe Text
executionRoleArn} -> Maybe Text
executionRoleArn) (\s :: Canary
s@Canary' {} Maybe Text
a -> Canary
s {$sel:executionRoleArn:Canary' :: Maybe Text
executionRoleArn = Maybe Text
a} :: Canary)

-- | The number of days to retain data about failed runs of this canary.
canary_failureRetentionPeriodInDays :: Lens.Lens' Canary (Prelude.Maybe Prelude.Natural)
canary_failureRetentionPeriodInDays :: Lens' Canary (Maybe Natural)
canary_failureRetentionPeriodInDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe Natural
failureRetentionPeriodInDays :: Maybe Natural
$sel:failureRetentionPeriodInDays:Canary' :: Canary -> Maybe Natural
failureRetentionPeriodInDays} -> Maybe Natural
failureRetentionPeriodInDays) (\s :: Canary
s@Canary' {} Maybe Natural
a -> Canary
s {$sel:failureRetentionPeriodInDays:Canary' :: Maybe Natural
failureRetentionPeriodInDays = Maybe Natural
a} :: Canary)

-- | The unique ID of this canary.
canary_id :: Lens.Lens' Canary (Prelude.Maybe Prelude.Text)
canary_id :: Lens' Canary (Maybe Text)
canary_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe Text
id :: Maybe Text
$sel:id:Canary' :: Canary -> Maybe Text
id} -> Maybe Text
id) (\s :: Canary
s@Canary' {} Maybe Text
a -> Canary
s {$sel:id:Canary' :: Maybe Text
id = Maybe Text
a} :: Canary)

-- | The name of the canary.
canary_name :: Lens.Lens' Canary (Prelude.Maybe Prelude.Text)
canary_name :: Lens' Canary (Maybe Text)
canary_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe Text
name :: Maybe Text
$sel:name:Canary' :: Canary -> Maybe Text
name} -> Maybe Text
name) (\s :: Canary
s@Canary' {} Maybe Text
a -> Canary
s {$sel:name:Canary' :: Maybe Text
name = Maybe Text
a} :: Canary)

-- | Undocumented member.
canary_runConfig :: Lens.Lens' Canary (Prelude.Maybe CanaryRunConfigOutput)
canary_runConfig :: Lens' Canary (Maybe CanaryRunConfigOutput)
canary_runConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe CanaryRunConfigOutput
runConfig :: Maybe CanaryRunConfigOutput
$sel:runConfig:Canary' :: Canary -> Maybe CanaryRunConfigOutput
runConfig} -> Maybe CanaryRunConfigOutput
runConfig) (\s :: Canary
s@Canary' {} Maybe CanaryRunConfigOutput
a -> Canary
s {$sel:runConfig:Canary' :: Maybe CanaryRunConfigOutput
runConfig = Maybe CanaryRunConfigOutput
a} :: Canary)

-- | Specifies the runtime version to use for the canary. For more
-- information about runtime versions, see
-- <https://docs.aws.amazon.com/AmazonCloudWatch/latest/monitoring/CloudWatch_Synthetics_Canaries_Library.html Canary Runtime Versions>.
canary_runtimeVersion :: Lens.Lens' Canary (Prelude.Maybe Prelude.Text)
canary_runtimeVersion :: Lens' Canary (Maybe Text)
canary_runtimeVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe Text
runtimeVersion :: Maybe Text
$sel:runtimeVersion:Canary' :: Canary -> Maybe Text
runtimeVersion} -> Maybe Text
runtimeVersion) (\s :: Canary
s@Canary' {} Maybe Text
a -> Canary
s {$sel:runtimeVersion:Canary' :: Maybe Text
runtimeVersion = Maybe Text
a} :: Canary)

-- | A structure that contains information about how often the canary is to
-- run, and when these runs are to stop.
canary_schedule :: Lens.Lens' Canary (Prelude.Maybe CanaryScheduleOutput)
canary_schedule :: Lens' Canary (Maybe CanaryScheduleOutput)
canary_schedule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe CanaryScheduleOutput
schedule :: Maybe CanaryScheduleOutput
$sel:schedule:Canary' :: Canary -> Maybe CanaryScheduleOutput
schedule} -> Maybe CanaryScheduleOutput
schedule) (\s :: Canary
s@Canary' {} Maybe CanaryScheduleOutput
a -> Canary
s {$sel:schedule:Canary' :: Maybe CanaryScheduleOutput
schedule = Maybe CanaryScheduleOutput
a} :: Canary)

-- | A structure that contains information about the canary\'s status.
canary_status :: Lens.Lens' Canary (Prelude.Maybe CanaryStatus)
canary_status :: Lens' Canary (Maybe CanaryStatus)
canary_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe CanaryStatus
status :: Maybe CanaryStatus
$sel:status:Canary' :: Canary -> Maybe CanaryStatus
status} -> Maybe CanaryStatus
status) (\s :: Canary
s@Canary' {} Maybe CanaryStatus
a -> Canary
s {$sel:status:Canary' :: Maybe CanaryStatus
status = Maybe CanaryStatus
a} :: Canary)

-- | The number of days to retain data about successful runs of this canary.
canary_successRetentionPeriodInDays :: Lens.Lens' Canary (Prelude.Maybe Prelude.Natural)
canary_successRetentionPeriodInDays :: Lens' Canary (Maybe Natural)
canary_successRetentionPeriodInDays = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe Natural
successRetentionPeriodInDays :: Maybe Natural
$sel:successRetentionPeriodInDays:Canary' :: Canary -> Maybe Natural
successRetentionPeriodInDays} -> Maybe Natural
successRetentionPeriodInDays) (\s :: Canary
s@Canary' {} Maybe Natural
a -> Canary
s {$sel:successRetentionPeriodInDays:Canary' :: Maybe Natural
successRetentionPeriodInDays = Maybe Natural
a} :: Canary)

-- | The list of key-value pairs that are associated with the canary.
canary_tags :: Lens.Lens' Canary (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
canary_tags :: Lens' Canary (Maybe (HashMap Text Text))
canary_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:Canary' :: Canary -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: Canary
s@Canary' {} Maybe (HashMap Text Text)
a -> Canary
s {$sel:tags:Canary' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: Canary) 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 structure that contains information about when the canary was created,
-- modified, and most recently run.
canary_timeline :: Lens.Lens' Canary (Prelude.Maybe CanaryTimeline)
canary_timeline :: Lens' Canary (Maybe CanaryTimeline)
canary_timeline = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe CanaryTimeline
timeline :: Maybe CanaryTimeline
$sel:timeline:Canary' :: Canary -> Maybe CanaryTimeline
timeline} -> Maybe CanaryTimeline
timeline) (\s :: Canary
s@Canary' {} Maybe CanaryTimeline
a -> Canary
s {$sel:timeline:Canary' :: Maybe CanaryTimeline
timeline = Maybe CanaryTimeline
a} :: Canary)

-- | If this canary performs visual monitoring by comparing screenshots, this
-- structure contains the ID of the canary run to use as the baseline for
-- screenshots, and the coordinates of any parts of the screen to ignore
-- during the visual monitoring comparison.
canary_visualReference :: Lens.Lens' Canary (Prelude.Maybe VisualReferenceOutput)
canary_visualReference :: Lens' Canary (Maybe VisualReferenceOutput)
canary_visualReference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe VisualReferenceOutput
visualReference :: Maybe VisualReferenceOutput
$sel:visualReference:Canary' :: Canary -> Maybe VisualReferenceOutput
visualReference} -> Maybe VisualReferenceOutput
visualReference) (\s :: Canary
s@Canary' {} Maybe VisualReferenceOutput
a -> Canary
s {$sel:visualReference:Canary' :: Maybe VisualReferenceOutput
visualReference = Maybe VisualReferenceOutput
a} :: Canary)

-- | Undocumented member.
canary_vpcConfig :: Lens.Lens' Canary (Prelude.Maybe VpcConfigOutput)
canary_vpcConfig :: Lens' Canary (Maybe VpcConfigOutput)
canary_vpcConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Canary' {Maybe VpcConfigOutput
vpcConfig :: Maybe VpcConfigOutput
$sel:vpcConfig:Canary' :: Canary -> Maybe VpcConfigOutput
vpcConfig} -> Maybe VpcConfigOutput
vpcConfig) (\s :: Canary
s@Canary' {} Maybe VpcConfigOutput
a -> Canary
s {$sel:vpcConfig:Canary' :: Maybe VpcConfigOutput
vpcConfig = Maybe VpcConfigOutput
a} :: Canary)

instance Data.FromJSON Canary where
  parseJSON :: Value -> Parser Canary
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Canary"
      ( \Object
x ->
          Maybe ArtifactConfigOutput
-> Maybe Text
-> Maybe CanaryCodeOutput
-> Maybe Text
-> Maybe Text
-> Maybe Natural
-> Maybe Text
-> Maybe Text
-> Maybe CanaryRunConfigOutput
-> Maybe Text
-> Maybe CanaryScheduleOutput
-> Maybe CanaryStatus
-> Maybe Natural
-> Maybe (HashMap Text Text)
-> Maybe CanaryTimeline
-> Maybe VisualReferenceOutput
-> Maybe VpcConfigOutput
-> Canary
Canary'
            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
"ArtifactConfig")
            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
"ArtifactS3Location")
            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
"Code")
            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
"EngineArn")
            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
"ExecutionRoleArn")
            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
"FailureRetentionPeriodInDays")
            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
"Id")
            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
"Name")
            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
"RunConfig")
            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
"RuntimeVersion")
            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
"Schedule")
            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
"Status")
            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
"SuccessRetentionPeriodInDays")
            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
"Tags" 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
"Timeline")
            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
"VisualReference")
            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
"VpcConfig")
      )

instance Prelude.Hashable Canary where
  hashWithSalt :: Int -> Canary -> Int
hashWithSalt Int
_salt Canary' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe CanaryCodeOutput
Maybe CanaryRunConfigOutput
Maybe CanaryScheduleOutput
Maybe CanaryStatus
Maybe CanaryTimeline
Maybe ArtifactConfigOutput
Maybe VisualReferenceOutput
Maybe VpcConfigOutput
vpcConfig :: Maybe VpcConfigOutput
visualReference :: Maybe VisualReferenceOutput
timeline :: Maybe CanaryTimeline
tags :: Maybe (HashMap Text Text)
successRetentionPeriodInDays :: Maybe Natural
status :: Maybe CanaryStatus
schedule :: Maybe CanaryScheduleOutput
runtimeVersion :: Maybe Text
runConfig :: Maybe CanaryRunConfigOutput
name :: Maybe Text
id :: Maybe Text
failureRetentionPeriodInDays :: Maybe Natural
executionRoleArn :: Maybe Text
engineArn :: Maybe Text
code :: Maybe CanaryCodeOutput
artifactS3Location :: Maybe Text
artifactConfig :: Maybe ArtifactConfigOutput
$sel:vpcConfig:Canary' :: Canary -> Maybe VpcConfigOutput
$sel:visualReference:Canary' :: Canary -> Maybe VisualReferenceOutput
$sel:timeline:Canary' :: Canary -> Maybe CanaryTimeline
$sel:tags:Canary' :: Canary -> Maybe (HashMap Text Text)
$sel:successRetentionPeriodInDays:Canary' :: Canary -> Maybe Natural
$sel:status:Canary' :: Canary -> Maybe CanaryStatus
$sel:schedule:Canary' :: Canary -> Maybe CanaryScheduleOutput
$sel:runtimeVersion:Canary' :: Canary -> Maybe Text
$sel:runConfig:Canary' :: Canary -> Maybe CanaryRunConfigOutput
$sel:name:Canary' :: Canary -> Maybe Text
$sel:id:Canary' :: Canary -> Maybe Text
$sel:failureRetentionPeriodInDays:Canary' :: Canary -> Maybe Natural
$sel:executionRoleArn:Canary' :: Canary -> Maybe Text
$sel:engineArn:Canary' :: Canary -> Maybe Text
$sel:code:Canary' :: Canary -> Maybe CanaryCodeOutput
$sel:artifactS3Location:Canary' :: Canary -> Maybe Text
$sel:artifactConfig:Canary' :: Canary -> Maybe ArtifactConfigOutput
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ArtifactConfigOutput
artifactConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
artifactS3Location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CanaryCodeOutput
code
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
executionRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
failureRetentionPeriodInDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CanaryRunConfigOutput
runConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
runtimeVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CanaryScheduleOutput
schedule
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CanaryStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
successRetentionPeriodInDays
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CanaryTimeline
timeline
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VisualReferenceOutput
visualReference
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcConfigOutput
vpcConfig

instance Prelude.NFData Canary where
  rnf :: Canary -> ()
rnf Canary' {Maybe Natural
Maybe Text
Maybe (HashMap Text Text)
Maybe CanaryCodeOutput
Maybe CanaryRunConfigOutput
Maybe CanaryScheduleOutput
Maybe CanaryStatus
Maybe CanaryTimeline
Maybe ArtifactConfigOutput
Maybe VisualReferenceOutput
Maybe VpcConfigOutput
vpcConfig :: Maybe VpcConfigOutput
visualReference :: Maybe VisualReferenceOutput
timeline :: Maybe CanaryTimeline
tags :: Maybe (HashMap Text Text)
successRetentionPeriodInDays :: Maybe Natural
status :: Maybe CanaryStatus
schedule :: Maybe CanaryScheduleOutput
runtimeVersion :: Maybe Text
runConfig :: Maybe CanaryRunConfigOutput
name :: Maybe Text
id :: Maybe Text
failureRetentionPeriodInDays :: Maybe Natural
executionRoleArn :: Maybe Text
engineArn :: Maybe Text
code :: Maybe CanaryCodeOutput
artifactS3Location :: Maybe Text
artifactConfig :: Maybe ArtifactConfigOutput
$sel:vpcConfig:Canary' :: Canary -> Maybe VpcConfigOutput
$sel:visualReference:Canary' :: Canary -> Maybe VisualReferenceOutput
$sel:timeline:Canary' :: Canary -> Maybe CanaryTimeline
$sel:tags:Canary' :: Canary -> Maybe (HashMap Text Text)
$sel:successRetentionPeriodInDays:Canary' :: Canary -> Maybe Natural
$sel:status:Canary' :: Canary -> Maybe CanaryStatus
$sel:schedule:Canary' :: Canary -> Maybe CanaryScheduleOutput
$sel:runtimeVersion:Canary' :: Canary -> Maybe Text
$sel:runConfig:Canary' :: Canary -> Maybe CanaryRunConfigOutput
$sel:name:Canary' :: Canary -> Maybe Text
$sel:id:Canary' :: Canary -> Maybe Text
$sel:failureRetentionPeriodInDays:Canary' :: Canary -> Maybe Natural
$sel:executionRoleArn:Canary' :: Canary -> Maybe Text
$sel:engineArn:Canary' :: Canary -> Maybe Text
$sel:code:Canary' :: Canary -> Maybe CanaryCodeOutput
$sel:artifactS3Location:Canary' :: Canary -> Maybe Text
$sel:artifactConfig:Canary' :: Canary -> Maybe ArtifactConfigOutput
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ArtifactConfigOutput
artifactConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
artifactS3Location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CanaryCodeOutput
code
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
executionRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
failureRetentionPeriodInDays
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CanaryRunConfigOutput
runConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
runtimeVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CanaryScheduleOutput
schedule
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CanaryStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
successRetentionPeriodInDays
      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 Maybe CanaryTimeline
timeline
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VisualReferenceOutput
visualReference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcConfigOutput
vpcConfig