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

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

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

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Evidently.Types.LaunchExecution
import Amazonka.Evidently.Types.LaunchGroup
import Amazonka.Evidently.Types.LaunchStatus
import Amazonka.Evidently.Types.LaunchType
import Amazonka.Evidently.Types.MetricMonitor
import Amazonka.Evidently.Types.ScheduledSplitsLaunchDefinition
import qualified Amazonka.Prelude as Prelude

-- | This structure contains the configuration details of one Evidently
-- launch.
--
-- /See:/ 'newLaunch' smart constructor.
data Launch = Launch'
  { -- | The description of the launch.
    Launch -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A structure that contains information about the start and end times of
    -- the launch.
    Launch -> Maybe LaunchExecution
execution :: Prelude.Maybe LaunchExecution,
    -- | An array of structures that define the feature variations that are being
    -- used in the launch.
    Launch -> Maybe [LaunchGroup]
groups :: Prelude.Maybe [LaunchGroup],
    -- | An array of structures that define the metrics that are being used to
    -- monitor the launch performance.
    Launch -> Maybe [MetricMonitor]
metricMonitors :: Prelude.Maybe [MetricMonitor],
    -- | The name or ARN of the project that contains the launch.
    Launch -> Maybe Text
project :: Prelude.Maybe Prelude.Text,
    -- | This value is used when Evidently assigns a particular user session to
    -- the launch, to help create a randomization ID to determine which
    -- variation the user session is served. This randomization ID is a
    -- combination of the entity ID and @randomizationSalt@.
    Launch -> Maybe Text
randomizationSalt :: Prelude.Maybe Prelude.Text,
    -- | An array of structures that define the traffic allocation percentages
    -- among the feature variations during each step of the launch.
    Launch -> Maybe ScheduledSplitsLaunchDefinition
scheduledSplitsDefinition :: Prelude.Maybe ScheduledSplitsLaunchDefinition,
    -- | If the launch was stopped, this is the string that was entered by the
    -- person who stopped the launch, to explain why it was stopped.
    Launch -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The list of tag keys and values associated with this launch.
    Launch -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The ARN of the launch.
    Launch -> Text
arn :: Prelude.Text,
    -- | The date and time that the launch is created.
    Launch -> POSIX
createdTime :: Data.POSIX,
    -- | The date and time that the launch was most recently updated.
    Launch -> POSIX
lastUpdatedTime :: Data.POSIX,
    -- | The name of the launch.
    Launch -> Text
name :: Prelude.Text,
    -- | The current state of the launch.
    Launch -> LaunchStatus
status :: LaunchStatus,
    -- | The type of launch.
    Launch -> LaunchType
type' :: LaunchType
  }
  deriving (Launch -> Launch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Launch -> Launch -> Bool
$c/= :: Launch -> Launch -> Bool
== :: Launch -> Launch -> Bool
$c== :: Launch -> Launch -> Bool
Prelude.Eq, ReadPrec [Launch]
ReadPrec Launch
Int -> ReadS Launch
ReadS [Launch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Launch]
$creadListPrec :: ReadPrec [Launch]
readPrec :: ReadPrec Launch
$creadPrec :: ReadPrec Launch
readList :: ReadS [Launch]
$creadList :: ReadS [Launch]
readsPrec :: Int -> ReadS Launch
$creadsPrec :: Int -> ReadS Launch
Prelude.Read, Int -> Launch -> ShowS
[Launch] -> ShowS
Launch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Launch] -> ShowS
$cshowList :: [Launch] -> ShowS
show :: Launch -> String
$cshow :: Launch -> String
showsPrec :: Int -> Launch -> ShowS
$cshowsPrec :: Int -> Launch -> ShowS
Prelude.Show, forall x. Rep Launch x -> Launch
forall x. Launch -> Rep Launch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Launch x -> Launch
$cfrom :: forall x. Launch -> Rep Launch x
Prelude.Generic)

-- |
-- Create a value of 'Launch' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'description', 'launch_description' - The description of the launch.
--
-- 'execution', 'launch_execution' - A structure that contains information about the start and end times of
-- the launch.
--
-- 'groups', 'launch_groups' - An array of structures that define the feature variations that are being
-- used in the launch.
--
-- 'metricMonitors', 'launch_metricMonitors' - An array of structures that define the metrics that are being used to
-- monitor the launch performance.
--
-- 'project', 'launch_project' - The name or ARN of the project that contains the launch.
--
-- 'randomizationSalt', 'launch_randomizationSalt' - This value is used when Evidently assigns a particular user session to
-- the launch, to help create a randomization ID to determine which
-- variation the user session is served. This randomization ID is a
-- combination of the entity ID and @randomizationSalt@.
--
-- 'scheduledSplitsDefinition', 'launch_scheduledSplitsDefinition' - An array of structures that define the traffic allocation percentages
-- among the feature variations during each step of the launch.
--
-- 'statusReason', 'launch_statusReason' - If the launch was stopped, this is the string that was entered by the
-- person who stopped the launch, to explain why it was stopped.
--
-- 'tags', 'launch_tags' - The list of tag keys and values associated with this launch.
--
-- 'arn', 'launch_arn' - The ARN of the launch.
--
-- 'createdTime', 'launch_createdTime' - The date and time that the launch is created.
--
-- 'lastUpdatedTime', 'launch_lastUpdatedTime' - The date and time that the launch was most recently updated.
--
-- 'name', 'launch_name' - The name of the launch.
--
-- 'status', 'launch_status' - The current state of the launch.
--
-- 'type'', 'launch_type' - The type of launch.
newLaunch ::
  -- | 'arn'
  Prelude.Text ->
  -- | 'createdTime'
  Prelude.UTCTime ->
  -- | 'lastUpdatedTime'
  Prelude.UTCTime ->
  -- | 'name'
  Prelude.Text ->
  -- | 'status'
  LaunchStatus ->
  -- | 'type''
  LaunchType ->
  Launch
newLaunch :: Text
-> UTCTime
-> UTCTime
-> Text
-> LaunchStatus
-> LaunchType
-> Launch
newLaunch
  Text
pArn_
  UTCTime
pCreatedTime_
  UTCTime
pLastUpdatedTime_
  Text
pName_
  LaunchStatus
pStatus_
  LaunchType
pType_ =
    Launch'
      { $sel:description:Launch' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:execution:Launch' :: Maybe LaunchExecution
execution = forall a. Maybe a
Prelude.Nothing,
        $sel:groups:Launch' :: Maybe [LaunchGroup]
groups = forall a. Maybe a
Prelude.Nothing,
        $sel:metricMonitors:Launch' :: Maybe [MetricMonitor]
metricMonitors = forall a. Maybe a
Prelude.Nothing,
        $sel:project:Launch' :: Maybe Text
project = forall a. Maybe a
Prelude.Nothing,
        $sel:randomizationSalt:Launch' :: Maybe Text
randomizationSalt = forall a. Maybe a
Prelude.Nothing,
        $sel:scheduledSplitsDefinition:Launch' :: Maybe ScheduledSplitsLaunchDefinition
scheduledSplitsDefinition = forall a. Maybe a
Prelude.Nothing,
        $sel:statusReason:Launch' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:Launch' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:arn:Launch' :: Text
arn = Text
pArn_,
        $sel:createdTime:Launch' :: POSIX
createdTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedTime_,
        $sel:lastUpdatedTime:Launch' :: POSIX
lastUpdatedTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastUpdatedTime_,
        $sel:name:Launch' :: Text
name = Text
pName_,
        $sel:status:Launch' :: LaunchStatus
status = LaunchStatus
pStatus_,
        $sel:type':Launch' :: LaunchType
type' = LaunchType
pType_
      }

-- | The description of the launch.
launch_description :: Lens.Lens' Launch (Prelude.Maybe Prelude.Text)
launch_description :: Lens' Launch (Maybe Text)
launch_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe Text
description :: Maybe Text
$sel:description:Launch' :: Launch -> Maybe Text
description} -> Maybe Text
description) (\s :: Launch
s@Launch' {} Maybe Text
a -> Launch
s {$sel:description:Launch' :: Maybe Text
description = Maybe Text
a} :: Launch)

-- | A structure that contains information about the start and end times of
-- the launch.
launch_execution :: Lens.Lens' Launch (Prelude.Maybe LaunchExecution)
launch_execution :: Lens' Launch (Maybe LaunchExecution)
launch_execution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe LaunchExecution
execution :: Maybe LaunchExecution
$sel:execution:Launch' :: Launch -> Maybe LaunchExecution
execution} -> Maybe LaunchExecution
execution) (\s :: Launch
s@Launch' {} Maybe LaunchExecution
a -> Launch
s {$sel:execution:Launch' :: Maybe LaunchExecution
execution = Maybe LaunchExecution
a} :: Launch)

-- | An array of structures that define the feature variations that are being
-- used in the launch.
launch_groups :: Lens.Lens' Launch (Prelude.Maybe [LaunchGroup])
launch_groups :: Lens' Launch (Maybe [LaunchGroup])
launch_groups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe [LaunchGroup]
groups :: Maybe [LaunchGroup]
$sel:groups:Launch' :: Launch -> Maybe [LaunchGroup]
groups} -> Maybe [LaunchGroup]
groups) (\s :: Launch
s@Launch' {} Maybe [LaunchGroup]
a -> Launch
s {$sel:groups:Launch' :: Maybe [LaunchGroup]
groups = Maybe [LaunchGroup]
a} :: Launch) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | An array of structures that define the metrics that are being used to
-- monitor the launch performance.
launch_metricMonitors :: Lens.Lens' Launch (Prelude.Maybe [MetricMonitor])
launch_metricMonitors :: Lens' Launch (Maybe [MetricMonitor])
launch_metricMonitors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe [MetricMonitor]
metricMonitors :: Maybe [MetricMonitor]
$sel:metricMonitors:Launch' :: Launch -> Maybe [MetricMonitor]
metricMonitors} -> Maybe [MetricMonitor]
metricMonitors) (\s :: Launch
s@Launch' {} Maybe [MetricMonitor]
a -> Launch
s {$sel:metricMonitors:Launch' :: Maybe [MetricMonitor]
metricMonitors = Maybe [MetricMonitor]
a} :: Launch) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name or ARN of the project that contains the launch.
launch_project :: Lens.Lens' Launch (Prelude.Maybe Prelude.Text)
launch_project :: Lens' Launch (Maybe Text)
launch_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe Text
project :: Maybe Text
$sel:project:Launch' :: Launch -> Maybe Text
project} -> Maybe Text
project) (\s :: Launch
s@Launch' {} Maybe Text
a -> Launch
s {$sel:project:Launch' :: Maybe Text
project = Maybe Text
a} :: Launch)

-- | This value is used when Evidently assigns a particular user session to
-- the launch, to help create a randomization ID to determine which
-- variation the user session is served. This randomization ID is a
-- combination of the entity ID and @randomizationSalt@.
launch_randomizationSalt :: Lens.Lens' Launch (Prelude.Maybe Prelude.Text)
launch_randomizationSalt :: Lens' Launch (Maybe Text)
launch_randomizationSalt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe Text
randomizationSalt :: Maybe Text
$sel:randomizationSalt:Launch' :: Launch -> Maybe Text
randomizationSalt} -> Maybe Text
randomizationSalt) (\s :: Launch
s@Launch' {} Maybe Text
a -> Launch
s {$sel:randomizationSalt:Launch' :: Maybe Text
randomizationSalt = Maybe Text
a} :: Launch)

-- | An array of structures that define the traffic allocation percentages
-- among the feature variations during each step of the launch.
launch_scheduledSplitsDefinition :: Lens.Lens' Launch (Prelude.Maybe ScheduledSplitsLaunchDefinition)
launch_scheduledSplitsDefinition :: Lens' Launch (Maybe ScheduledSplitsLaunchDefinition)
launch_scheduledSplitsDefinition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe ScheduledSplitsLaunchDefinition
scheduledSplitsDefinition :: Maybe ScheduledSplitsLaunchDefinition
$sel:scheduledSplitsDefinition:Launch' :: Launch -> Maybe ScheduledSplitsLaunchDefinition
scheduledSplitsDefinition} -> Maybe ScheduledSplitsLaunchDefinition
scheduledSplitsDefinition) (\s :: Launch
s@Launch' {} Maybe ScheduledSplitsLaunchDefinition
a -> Launch
s {$sel:scheduledSplitsDefinition:Launch' :: Maybe ScheduledSplitsLaunchDefinition
scheduledSplitsDefinition = Maybe ScheduledSplitsLaunchDefinition
a} :: Launch)

-- | If the launch was stopped, this is the string that was entered by the
-- person who stopped the launch, to explain why it was stopped.
launch_statusReason :: Lens.Lens' Launch (Prelude.Maybe Prelude.Text)
launch_statusReason :: Lens' Launch (Maybe Text)
launch_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:Launch' :: Launch -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: Launch
s@Launch' {} Maybe Text
a -> Launch
s {$sel:statusReason:Launch' :: Maybe Text
statusReason = Maybe Text
a} :: Launch)

-- | The list of tag keys and values associated with this launch.
launch_tags :: Lens.Lens' Launch (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
launch_tags :: Lens' Launch (Maybe (HashMap Text Text))
launch_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:Launch' :: Launch -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: Launch
s@Launch' {} Maybe (HashMap Text Text)
a -> Launch
s {$sel:tags:Launch' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: Launch) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ARN of the launch.
launch_arn :: Lens.Lens' Launch Prelude.Text
launch_arn :: Lens' Launch Text
launch_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {Text
arn :: Text
$sel:arn:Launch' :: Launch -> Text
arn} -> Text
arn) (\s :: Launch
s@Launch' {} Text
a -> Launch
s {$sel:arn:Launch' :: Text
arn = Text
a} :: Launch)

-- | The date and time that the launch is created.
launch_createdTime :: Lens.Lens' Launch Prelude.UTCTime
launch_createdTime :: Lens' Launch UTCTime
launch_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {POSIX
createdTime :: POSIX
$sel:createdTime:Launch' :: Launch -> POSIX
createdTime} -> POSIX
createdTime) (\s :: Launch
s@Launch' {} POSIX
a -> Launch
s {$sel:createdTime:Launch' :: POSIX
createdTime = POSIX
a} :: Launch) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date and time that the launch was most recently updated.
launch_lastUpdatedTime :: Lens.Lens' Launch Prelude.UTCTime
launch_lastUpdatedTime :: Lens' Launch UTCTime
launch_lastUpdatedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {POSIX
lastUpdatedTime :: POSIX
$sel:lastUpdatedTime:Launch' :: Launch -> POSIX
lastUpdatedTime} -> POSIX
lastUpdatedTime) (\s :: Launch
s@Launch' {} POSIX
a -> Launch
s {$sel:lastUpdatedTime:Launch' :: POSIX
lastUpdatedTime = POSIX
a} :: Launch) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

-- | The current state of the launch.
launch_status :: Lens.Lens' Launch LaunchStatus
launch_status :: Lens' Launch LaunchStatus
launch_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {LaunchStatus
status :: LaunchStatus
$sel:status:Launch' :: Launch -> LaunchStatus
status} -> LaunchStatus
status) (\s :: Launch
s@Launch' {} LaunchStatus
a -> Launch
s {$sel:status:Launch' :: LaunchStatus
status = LaunchStatus
a} :: Launch)

-- | The type of launch.
launch_type :: Lens.Lens' Launch LaunchType
launch_type :: Lens' Launch LaunchType
launch_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Launch' {LaunchType
type' :: LaunchType
$sel:type':Launch' :: Launch -> LaunchType
type'} -> LaunchType
type') (\s :: Launch
s@Launch' {} LaunchType
a -> Launch
s {$sel:type':Launch' :: LaunchType
type' = LaunchType
a} :: Launch)

instance Data.FromJSON Launch where
  parseJSON :: Value -> Parser Launch
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Launch"
      ( \Object
x ->
          Maybe Text
-> Maybe LaunchExecution
-> Maybe [LaunchGroup]
-> Maybe [MetricMonitor]
-> Maybe Text
-> Maybe Text
-> Maybe ScheduledSplitsLaunchDefinition
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Text
-> POSIX
-> POSIX
-> Text
-> LaunchStatus
-> LaunchType
-> Launch
Launch'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"execution")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"groups" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"metricMonitors" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"project")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"randomizationSalt")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"scheduledSplitsDefinition")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"statusReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"createdTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"lastUpdatedTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"type")
      )

instance Prelude.Hashable Launch where
  hashWithSalt :: Int -> Launch -> Int
hashWithSalt Int
_salt Launch' {Maybe [LaunchGroup]
Maybe [MetricMonitor]
Maybe Text
Maybe (HashMap Text Text)
Maybe LaunchExecution
Maybe ScheduledSplitsLaunchDefinition
Text
POSIX
LaunchStatus
LaunchType
type' :: LaunchType
status :: LaunchStatus
name :: Text
lastUpdatedTime :: POSIX
createdTime :: POSIX
arn :: Text
tags :: Maybe (HashMap Text Text)
statusReason :: Maybe Text
scheduledSplitsDefinition :: Maybe ScheduledSplitsLaunchDefinition
randomizationSalt :: Maybe Text
project :: Maybe Text
metricMonitors :: Maybe [MetricMonitor]
groups :: Maybe [LaunchGroup]
execution :: Maybe LaunchExecution
description :: Maybe Text
$sel:type':Launch' :: Launch -> LaunchType
$sel:status:Launch' :: Launch -> LaunchStatus
$sel:name:Launch' :: Launch -> Text
$sel:lastUpdatedTime:Launch' :: Launch -> POSIX
$sel:createdTime:Launch' :: Launch -> POSIX
$sel:arn:Launch' :: Launch -> Text
$sel:tags:Launch' :: Launch -> Maybe (HashMap Text Text)
$sel:statusReason:Launch' :: Launch -> Maybe Text
$sel:scheduledSplitsDefinition:Launch' :: Launch -> Maybe ScheduledSplitsLaunchDefinition
$sel:randomizationSalt:Launch' :: Launch -> Maybe Text
$sel:project:Launch' :: Launch -> Maybe Text
$sel:metricMonitors:Launch' :: Launch -> Maybe [MetricMonitor]
$sel:groups:Launch' :: Launch -> Maybe [LaunchGroup]
$sel:execution:Launch' :: Launch -> Maybe LaunchExecution
$sel:description:Launch' :: Launch -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LaunchExecution
execution
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [LaunchGroup]
groups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [MetricMonitor]
metricMonitors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
project
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
randomizationSalt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ScheduledSplitsLaunchDefinition
scheduledSplitsDefinition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
createdTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
lastUpdatedTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LaunchStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` LaunchType
type'

instance Prelude.NFData Launch where
  rnf :: Launch -> ()
rnf Launch' {Maybe [LaunchGroup]
Maybe [MetricMonitor]
Maybe Text
Maybe (HashMap Text Text)
Maybe LaunchExecution
Maybe ScheduledSplitsLaunchDefinition
Text
POSIX
LaunchStatus
LaunchType
type' :: LaunchType
status :: LaunchStatus
name :: Text
lastUpdatedTime :: POSIX
createdTime :: POSIX
arn :: Text
tags :: Maybe (HashMap Text Text)
statusReason :: Maybe Text
scheduledSplitsDefinition :: Maybe ScheduledSplitsLaunchDefinition
randomizationSalt :: Maybe Text
project :: Maybe Text
metricMonitors :: Maybe [MetricMonitor]
groups :: Maybe [LaunchGroup]
execution :: Maybe LaunchExecution
description :: Maybe Text
$sel:type':Launch' :: Launch -> LaunchType
$sel:status:Launch' :: Launch -> LaunchStatus
$sel:name:Launch' :: Launch -> Text
$sel:lastUpdatedTime:Launch' :: Launch -> POSIX
$sel:createdTime:Launch' :: Launch -> POSIX
$sel:arn:Launch' :: Launch -> Text
$sel:tags:Launch' :: Launch -> Maybe (HashMap Text Text)
$sel:statusReason:Launch' :: Launch -> Maybe Text
$sel:scheduledSplitsDefinition:Launch' :: Launch -> Maybe ScheduledSplitsLaunchDefinition
$sel:randomizationSalt:Launch' :: Launch -> Maybe Text
$sel:project:Launch' :: Launch -> Maybe Text
$sel:metricMonitors:Launch' :: Launch -> Maybe [MetricMonitor]
$sel:groups:Launch' :: Launch -> Maybe [LaunchGroup]
$sel:execution:Launch' :: Launch -> Maybe LaunchExecution
$sel:description:Launch' :: Launch -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LaunchExecution
execution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [LaunchGroup]
groups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [MetricMonitor]
metricMonitors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
project
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
randomizationSalt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ScheduledSplitsLaunchDefinition
scheduledSplitsDefinition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
createdTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
lastUpdatedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LaunchStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf LaunchType
type'