module Stratosphere.Synthetics.Canary (
        module Exports, Canary(..), mkCanary
    ) where
import qualified Data.Aeson as JSON
import qualified Stratosphere.Prelude as Prelude
import Stratosphere.Property
import {-# SOURCE #-} Stratosphere.Synthetics.Canary.ArtifactConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.Synthetics.Canary.BrowserConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.Synthetics.Canary.CodeProperty as Exports
import {-# SOURCE #-} Stratosphere.Synthetics.Canary.RunConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.Synthetics.Canary.ScheduleProperty as Exports
import {-# SOURCE #-} Stratosphere.Synthetics.Canary.VPCConfigProperty as Exports
import {-# SOURCE #-} Stratosphere.Synthetics.Canary.VisualReferenceProperty as Exports
import Stratosphere.ResourceProperties
import Stratosphere.Tag
import Stratosphere.Value
data Canary
  = -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html>
    Canary {Canary -> ()
haddock_workaround_ :: (),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-artifactconfig>
            Canary -> Maybe ArtifactConfigProperty
artifactConfig :: (Prelude.Maybe ArtifactConfigProperty),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-artifacts3location>
            Canary -> Value Text
artifactS3Location :: (Value Prelude.Text),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-browserconfigs>
            Canary -> Maybe [BrowserConfigProperty]
browserConfigs :: (Prelude.Maybe [BrowserConfigProperty]),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-code>
            Canary -> CodeProperty
code :: CodeProperty,
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-dryrunandupdate>
            Canary -> Maybe (Value Bool)
dryRunAndUpdate :: (Prelude.Maybe (Value Prelude.Bool)),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-executionrolearn>
            Canary -> Value Text
executionRoleArn :: (Value Prelude.Text),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-failureretentionperiod>
            Canary -> Maybe (Value Integer)
failureRetentionPeriod :: (Prelude.Maybe (Value Prelude.Integer)),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-name>
            Canary -> Value Text
name :: (Value Prelude.Text),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-provisionedresourcecleanup>
            Canary -> Maybe (Value Text)
provisionedResourceCleanup :: (Prelude.Maybe (Value Prelude.Text)),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-resourcestoreplicatetags>
            Canary -> Maybe (ValueList Text)
resourcesToReplicateTags :: (Prelude.Maybe (ValueList Prelude.Text)),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-runconfig>
            Canary -> Maybe RunConfigProperty
runConfig :: (Prelude.Maybe RunConfigProperty),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-runtimeversion>
            Canary -> Value Text
runtimeVersion :: (Value Prelude.Text),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-schedule>
            Canary -> ScheduleProperty
schedule :: ScheduleProperty,
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-startcanaryaftercreation>
            Canary -> Maybe (Value Bool)
startCanaryAfterCreation :: (Prelude.Maybe (Value Prelude.Bool)),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-successretentionperiod>
            Canary -> Maybe (Value Integer)
successRetentionPeriod :: (Prelude.Maybe (Value Prelude.Integer)),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-tags>
            Canary -> Maybe [Tag]
tags :: (Prelude.Maybe [Tag]),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-vpcconfig>
            Canary -> Maybe VPCConfigProperty
vPCConfig :: (Prelude.Maybe VPCConfigProperty),
            -- | See: <http://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/aws-resource-synthetics-canary.html#cfn-synthetics-canary-visualreferences>
            Canary -> Maybe [VisualReferenceProperty]
visualReferences :: (Prelude.Maybe [VisualReferenceProperty])}
  deriving stock (Canary -> Canary -> Bool
(Canary -> Canary -> Bool)
-> (Canary -> Canary -> Bool) -> Eq Canary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Canary -> Canary -> Bool
== :: Canary -> Canary -> Bool
$c/= :: Canary -> Canary -> Bool
/= :: Canary -> Canary -> Bool
Prelude.Eq, Int -> Canary -> ShowS
[Canary] -> ShowS
Canary -> String
(Int -> Canary -> ShowS)
-> (Canary -> String) -> ([Canary] -> ShowS) -> Show Canary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Canary -> ShowS
showsPrec :: Int -> Canary -> ShowS
$cshow :: Canary -> String
show :: Canary -> String
$cshowList :: [Canary] -> ShowS
showList :: [Canary] -> ShowS
Prelude.Show)
mkCanary ::
  Value Prelude.Text
  -> CodeProperty
     -> Value Prelude.Text
        -> Value Prelude.Text
           -> Value Prelude.Text -> ScheduleProperty -> Canary
mkCanary :: Value Text
-> CodeProperty
-> Value Text
-> Value Text
-> Value Text
-> ScheduleProperty
-> Canary
mkCanary
  Value Text
artifactS3Location
  CodeProperty
code
  Value Text
executionRoleArn
  Value Text
name
  Value Text
runtimeVersion
  ScheduleProperty
schedule
  = Canary
      {haddock_workaround_ :: ()
haddock_workaround_ = (), artifactS3Location :: Value Text
artifactS3Location = Value Text
artifactS3Location,
       code :: CodeProperty
code = CodeProperty
code, executionRoleArn :: Value Text
executionRoleArn = Value Text
executionRoleArn, name :: Value Text
name = Value Text
name,
       runtimeVersion :: Value Text
runtimeVersion = Value Text
runtimeVersion, schedule :: ScheduleProperty
schedule = ScheduleProperty
schedule,
       artifactConfig :: Maybe ArtifactConfigProperty
artifactConfig = Maybe ArtifactConfigProperty
forall a. Maybe a
Prelude.Nothing, browserConfigs :: Maybe [BrowserConfigProperty]
browserConfigs = Maybe [BrowserConfigProperty]
forall a. Maybe a
Prelude.Nothing,
       dryRunAndUpdate :: Maybe (Value Bool)
dryRunAndUpdate = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       failureRetentionPeriod :: Maybe (Value Integer)
failureRetentionPeriod = Maybe (Value Integer)
forall a. Maybe a
Prelude.Nothing,
       provisionedResourceCleanup :: Maybe (Value Text)
provisionedResourceCleanup = Maybe (Value Text)
forall a. Maybe a
Prelude.Nothing,
       resourcesToReplicateTags :: Maybe (ValueList Text)
resourcesToReplicateTags = Maybe (ValueList Text)
forall a. Maybe a
Prelude.Nothing,
       runConfig :: Maybe RunConfigProperty
runConfig = Maybe RunConfigProperty
forall a. Maybe a
Prelude.Nothing,
       startCanaryAfterCreation :: Maybe (Value Bool)
startCanaryAfterCreation = Maybe (Value Bool)
forall a. Maybe a
Prelude.Nothing,
       successRetentionPeriod :: Maybe (Value Integer)
successRetentionPeriod = Maybe (Value Integer)
forall a. Maybe a
Prelude.Nothing, tags :: Maybe [Tag]
tags = Maybe [Tag]
forall a. Maybe a
Prelude.Nothing,
       vPCConfig :: Maybe VPCConfigProperty
vPCConfig = Maybe VPCConfigProperty
forall a. Maybe a
Prelude.Nothing, visualReferences :: Maybe [VisualReferenceProperty]
visualReferences = Maybe [VisualReferenceProperty]
forall a. Maybe a
Prelude.Nothing}
instance ToResourceProperties Canary where
  toResourceProperties :: Canary -> ResourceProperties
toResourceProperties Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = ResourceProperties
        {awsType :: Text
awsType = Text
"AWS::Synthetics::Canary", supportsTags :: Bool
supportsTags = Bool
Prelude.True,
         properties :: Object
properties = [Item Object] -> Object
forall l. IsList l => [Item l] -> l
Prelude.fromList
                        ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
                           [Key
"ArtifactS3Location" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
artifactS3Location,
                            Key
"Code" Key -> CodeProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= CodeProperty
code, Key
"ExecutionRoleArn" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
executionRoleArn,
                            Key
"Name" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
name, Key
"RuntimeVersion" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
runtimeVersion,
                            Key
"Schedule" Key -> ScheduleProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ScheduleProperty
schedule]
                           ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                              [Key -> ArtifactConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ArtifactConfig" (ArtifactConfigProperty -> (Key, Value))
-> Maybe ArtifactConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ArtifactConfigProperty
artifactConfig,
                               Key -> [BrowserConfigProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"BrowserConfigs" ([BrowserConfigProperty] -> (Key, Value))
-> Maybe [BrowserConfigProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [BrowserConfigProperty]
browserConfigs,
                               Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"DryRunAndUpdate" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
dryRunAndUpdate,
                               Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"FailureRetentionPeriod"
                                 (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
failureRetentionPeriod,
                               Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ProvisionedResourceCleanup"
                                 (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
provisionedResourceCleanup,
                               Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ResourcesToReplicateTags"
                                 (ValueList Text -> (Key, Value))
-> Maybe (ValueList Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (ValueList Text)
resourcesToReplicateTags,
                               Key -> RunConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RunConfig" (RunConfigProperty -> (Key, Value))
-> Maybe RunConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RunConfigProperty
runConfig,
                               Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"StartCanaryAfterCreation"
                                 (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
startCanaryAfterCreation,
                               Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"SuccessRetentionPeriod"
                                 (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
successRetentionPeriod,
                               Key -> [Tag] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tags" ([Tag] -> (Key, Value)) -> Maybe [Tag] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
                               Key -> VPCConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"VPCConfig" (VPCConfigProperty -> (Key, Value))
-> Maybe VPCConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe VPCConfigProperty
vPCConfig,
                               Key -> [VisualReferenceProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"VisualReferences" ([VisualReferenceProperty] -> (Key, Value))
-> Maybe [VisualReferenceProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [VisualReferenceProperty]
visualReferences]))}
instance JSON.ToJSON Canary where
  toJSON :: Canary -> Value
toJSON Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = [(Key, Value)] -> Value
JSON.object
        ([Item [(Key, Value)]] -> [(Key, Value)]
forall l. IsList l => [Item l] -> l
Prelude.fromList
           ([(Key, Value)] -> [(Key, Value)] -> [(Key, Value)]
forall a. Semigroup a => a -> a -> a
(Prelude.<>)
              [Key
"ArtifactS3Location" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
artifactS3Location,
               Key
"Code" Key -> CodeProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= CodeProperty
code, Key
"ExecutionRoleArn" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
executionRoleArn,
               Key
"Name" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
name, Key
"RuntimeVersion" Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= Value Text
runtimeVersion,
               Key
"Schedule" Key -> ScheduleProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
JSON..= ScheduleProperty
schedule]
              ([Maybe (Key, Value)] -> [(Key, Value)]
forall a. [Maybe a] -> [a]
Prelude.catMaybes
                 [Key -> ArtifactConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ArtifactConfig" (ArtifactConfigProperty -> (Key, Value))
-> Maybe ArtifactConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ArtifactConfigProperty
artifactConfig,
                  Key -> [BrowserConfigProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"BrowserConfigs" ([BrowserConfigProperty] -> (Key, Value))
-> Maybe [BrowserConfigProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [BrowserConfigProperty]
browserConfigs,
                  Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"DryRunAndUpdate" (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
dryRunAndUpdate,
                  Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"FailureRetentionPeriod"
                    (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
failureRetentionPeriod,
                  Key -> Value Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ProvisionedResourceCleanup"
                    (Value Text -> (Key, Value))
-> Maybe (Value Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Text)
provisionedResourceCleanup,
                  Key -> ValueList Text -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"ResourcesToReplicateTags"
                    (ValueList Text -> (Key, Value))
-> Maybe (ValueList Text) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (ValueList Text)
resourcesToReplicateTags,
                  Key -> RunConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"RunConfig" (RunConfigProperty -> (Key, Value))
-> Maybe RunConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe RunConfigProperty
runConfig,
                  Key -> Value Bool -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"StartCanaryAfterCreation"
                    (Value Bool -> (Key, Value))
-> Maybe (Value Bool) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Bool)
startCanaryAfterCreation,
                  Key -> Value Integer -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"SuccessRetentionPeriod"
                    (Value Integer -> (Key, Value))
-> Maybe (Value Integer) -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (Value Integer)
successRetentionPeriod,
                  Key -> [Tag] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"Tags" ([Tag] -> (Key, Value)) -> Maybe [Tag] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
                  Key -> VPCConfigProperty -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"VPCConfig" (VPCConfigProperty -> (Key, Value))
-> Maybe VPCConfigProperty -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe VPCConfigProperty
vPCConfig,
                  Key -> [VisualReferenceProperty] -> (Key, Value)
forall v. ToJSON v => Key -> v -> (Key, Value)
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
(JSON..=) Key
"VisualReferences" ([VisualReferenceProperty] -> (Key, Value))
-> Maybe [VisualReferenceProperty] -> Maybe (Key, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [VisualReferenceProperty]
visualReferences])))
instance Property "ArtifactConfig" Canary where
  type PropertyType "ArtifactConfig" Canary = ArtifactConfigProperty
  set :: PropertyType "ArtifactConfig" Canary -> Canary -> Canary
set PropertyType "ArtifactConfig" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {artifactConfig :: Maybe ArtifactConfigProperty
artifactConfig = ArtifactConfigProperty -> Maybe ArtifactConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ArtifactConfig" Canary
ArtifactConfigProperty
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "ArtifactS3Location" Canary where
  type PropertyType "ArtifactS3Location" Canary = Value Prelude.Text
  set :: PropertyType "ArtifactS3Location" Canary -> Canary -> Canary
set PropertyType "ArtifactS3Location" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {artifactS3Location :: Value Text
artifactS3Location = PropertyType "ArtifactS3Location" Canary
Value Text
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "BrowserConfigs" Canary where
  type PropertyType "BrowserConfigs" Canary = [BrowserConfigProperty]
  set :: PropertyType "BrowserConfigs" Canary -> Canary -> Canary
set PropertyType "BrowserConfigs" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {browserConfigs :: Maybe [BrowserConfigProperty]
browserConfigs = [BrowserConfigProperty] -> Maybe [BrowserConfigProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [BrowserConfigProperty]
PropertyType "BrowserConfigs" Canary
newValue, Maybe [Tag]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "Code" Canary where
  type PropertyType "Code" Canary = CodeProperty
  set :: PropertyType "Code" Canary -> Canary -> Canary
set PropertyType "Code" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..} = Canary {code :: CodeProperty
code = PropertyType "Code" Canary
CodeProperty
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "DryRunAndUpdate" Canary where
  type PropertyType "DryRunAndUpdate" Canary = Value Prelude.Bool
  set :: PropertyType "DryRunAndUpdate" Canary -> Canary -> Canary
set PropertyType "DryRunAndUpdate" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {dryRunAndUpdate :: Maybe (Value Bool)
dryRunAndUpdate = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "DryRunAndUpdate" Canary
Value Bool
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "ExecutionRoleArn" Canary where
  type PropertyType "ExecutionRoleArn" Canary = Value Prelude.Text
  set :: PropertyType "ExecutionRoleArn" Canary -> Canary -> Canary
set PropertyType "ExecutionRoleArn" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..} = Canary {executionRoleArn :: Value Text
executionRoleArn = PropertyType "ExecutionRoleArn" Canary
Value Text
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "FailureRetentionPeriod" Canary where
  type PropertyType "FailureRetentionPeriod" Canary = Value Prelude.Integer
  set :: PropertyType "FailureRetentionPeriod" Canary -> Canary -> Canary
set PropertyType "FailureRetentionPeriod" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {failureRetentionPeriod :: Maybe (Value Integer)
failureRetentionPeriod = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "FailureRetentionPeriod" Canary
Value Integer
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "Name" Canary where
  type PropertyType "Name" Canary = Value Prelude.Text
  set :: PropertyType "Name" Canary -> Canary -> Canary
set PropertyType "Name" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..} = Canary {name :: Value Text
name = PropertyType "Name" Canary
Value Text
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "ProvisionedResourceCleanup" Canary where
  type PropertyType "ProvisionedResourceCleanup" Canary = Value Prelude.Text
  set :: PropertyType "ProvisionedResourceCleanup" Canary
-> Canary -> Canary
set PropertyType "ProvisionedResourceCleanup" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {provisionedResourceCleanup :: Maybe (Value Text)
provisionedResourceCleanup = Value Text -> Maybe (Value Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ProvisionedResourceCleanup" Canary
Value Text
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "ResourcesToReplicateTags" Canary where
  type PropertyType "ResourcesToReplicateTags" Canary = ValueList Prelude.Text
  set :: PropertyType "ResourcesToReplicateTags" Canary -> Canary -> Canary
set PropertyType "ResourcesToReplicateTags" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {resourcesToReplicateTags :: Maybe (ValueList Text)
resourcesToReplicateTags = ValueList Text -> Maybe (ValueList Text)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "ResourcesToReplicateTags" Canary
ValueList Text
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "RunConfig" Canary where
  type PropertyType "RunConfig" Canary = RunConfigProperty
  set :: PropertyType "RunConfig" Canary -> Canary -> Canary
set PropertyType "RunConfig" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {runConfig :: Maybe RunConfigProperty
runConfig = RunConfigProperty -> Maybe RunConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "RunConfig" Canary
RunConfigProperty
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "RuntimeVersion" Canary where
  type PropertyType "RuntimeVersion" Canary = Value Prelude.Text
  set :: PropertyType "RuntimeVersion" Canary -> Canary -> Canary
set PropertyType "RuntimeVersion" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..} = Canary {runtimeVersion :: Value Text
runtimeVersion = PropertyType "RuntimeVersion" Canary
Value Text
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "Schedule" Canary where
  type PropertyType "Schedule" Canary = ScheduleProperty
  set :: PropertyType "Schedule" Canary -> Canary -> Canary
set PropertyType "Schedule" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..} = Canary {schedule :: ScheduleProperty
schedule = PropertyType "Schedule" Canary
ScheduleProperty
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "StartCanaryAfterCreation" Canary where
  type PropertyType "StartCanaryAfterCreation" Canary = Value Prelude.Bool
  set :: PropertyType "StartCanaryAfterCreation" Canary -> Canary -> Canary
set PropertyType "StartCanaryAfterCreation" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {startCanaryAfterCreation :: Maybe (Value Bool)
startCanaryAfterCreation = Value Bool -> Maybe (Value Bool)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "StartCanaryAfterCreation" Canary
Value Bool
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "SuccessRetentionPeriod" Canary where
  type PropertyType "SuccessRetentionPeriod" Canary = Value Prelude.Integer
  set :: PropertyType "SuccessRetentionPeriod" Canary -> Canary -> Canary
set PropertyType "SuccessRetentionPeriod" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {successRetentionPeriod :: Maybe (Value Integer)
successRetentionPeriod = Value Integer -> Maybe (Value Integer)
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "SuccessRetentionPeriod" Canary
Value Integer
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "Tags" Canary where
  type PropertyType "Tags" Canary = [Tag]
  set :: PropertyType "Tags" Canary -> Canary -> Canary
set PropertyType "Tags" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {tags :: Maybe [Tag]
tags = [Tag] -> Maybe [Tag]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [Tag]
PropertyType "Tags" Canary
newValue, Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "VPCConfig" Canary where
  type PropertyType "VPCConfig" Canary = VPCConfigProperty
  set :: PropertyType "VPCConfig" Canary -> Canary -> Canary
set PropertyType "VPCConfig" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {vPCConfig :: Maybe VPCConfigProperty
vPCConfig = VPCConfigProperty -> Maybe VPCConfigProperty
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure PropertyType "VPCConfig" Canary
VPCConfigProperty
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
visualReferences :: Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
visualReferences :: Maybe [VisualReferenceProperty]
..}
instance Property "VisualReferences" Canary where
  type PropertyType "VisualReferences" Canary = [VisualReferenceProperty]
  set :: PropertyType "VisualReferences" Canary -> Canary -> Canary
set PropertyType "VisualReferences" Canary
newValue Canary {Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe [VisualReferenceProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: Canary -> ()
artifactConfig :: Canary -> Maybe ArtifactConfigProperty
artifactS3Location :: Canary -> Value Text
browserConfigs :: Canary -> Maybe [BrowserConfigProperty]
code :: Canary -> CodeProperty
dryRunAndUpdate :: Canary -> Maybe (Value Bool)
executionRoleArn :: Canary -> Value Text
failureRetentionPeriod :: Canary -> Maybe (Value Integer)
name :: Canary -> Value Text
provisionedResourceCleanup :: Canary -> Maybe (Value Text)
resourcesToReplicateTags :: Canary -> Maybe (ValueList Text)
runConfig :: Canary -> Maybe RunConfigProperty
runtimeVersion :: Canary -> Value Text
schedule :: Canary -> ScheduleProperty
startCanaryAfterCreation :: Canary -> Maybe (Value Bool)
successRetentionPeriod :: Canary -> Maybe (Value Integer)
tags :: Canary -> Maybe [Tag]
vPCConfig :: Canary -> Maybe VPCConfigProperty
visualReferences :: Canary -> Maybe [VisualReferenceProperty]
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
visualReferences :: Maybe [VisualReferenceProperty]
..}
    = Canary {visualReferences :: Maybe [VisualReferenceProperty]
visualReferences = [VisualReferenceProperty] -> Maybe [VisualReferenceProperty]
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure [VisualReferenceProperty]
PropertyType "VisualReferences" Canary
newValue, Maybe [Tag]
Maybe [BrowserConfigProperty]
Maybe (ValueList Text)
Maybe (Value Bool)
Maybe (Value Integer)
Maybe (Value Text)
Maybe RunConfigProperty
Maybe ArtifactConfigProperty
Maybe VPCConfigProperty
()
Value Text
CodeProperty
ScheduleProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
haddock_workaround_ :: ()
artifactConfig :: Maybe ArtifactConfigProperty
artifactS3Location :: Value Text
browserConfigs :: Maybe [BrowserConfigProperty]
code :: CodeProperty
dryRunAndUpdate :: Maybe (Value Bool)
executionRoleArn :: Value Text
failureRetentionPeriod :: Maybe (Value Integer)
name :: Value Text
provisionedResourceCleanup :: Maybe (Value Text)
resourcesToReplicateTags :: Maybe (ValueList Text)
runConfig :: Maybe RunConfigProperty
runtimeVersion :: Value Text
schedule :: ScheduleProperty
startCanaryAfterCreation :: Maybe (Value Bool)
successRetentionPeriod :: Maybe (Value Integer)
tags :: Maybe [Tag]
vPCConfig :: Maybe VPCConfigProperty
..}