{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.CreateLaunch
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a /launch/ of a given feature. Before you create a launch, you
-- must create the feature to use for the launch.
--
-- You can use a launch to safely validate new features by serving them to
-- a specified percentage of your users while you roll out the feature. You
-- can monitor the performance of the new feature to help you decide when
-- to ramp up traffic to more users. This helps you reduce risk and
-- identify unintended consequences before you fully launch the feature.
--
-- Don\'t use this operation to update an existing launch. Instead, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_UpdateLaunch.html UpdateLaunch>.
module Amazonka.Evidently.CreateLaunch
  ( -- * Creating a Request
    CreateLaunch (..),
    newCreateLaunch,

    -- * Request Lenses
    createLaunch_description,
    createLaunch_metricMonitors,
    createLaunch_randomizationSalt,
    createLaunch_scheduledSplitsConfig,
    createLaunch_tags,
    createLaunch_groups,
    createLaunch_name,
    createLaunch_project,

    -- * Destructuring the Response
    CreateLaunchResponse (..),
    newCreateLaunchResponse,

    -- * Response Lenses
    createLaunchResponse_httpStatus,
    createLaunchResponse_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
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newCreateLaunch' smart constructor.
data CreateLaunch = CreateLaunch'
  { -- | An optional description for the launch.
    CreateLaunch -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An array of structures that define the metrics that will be used to
    -- monitor the launch performance.
    CreateLaunch -> Maybe [MetricMonitorConfig]
metricMonitors :: Prelude.Maybe [MetricMonitorConfig],
    -- | When Evidently assigns a particular user session to a launch, it must
    -- use a randomization ID to determine which variation the user session is
    -- served. This randomization ID is a combination of the entity ID and
    -- @randomizationSalt@. If you omit @randomizationSalt@, Evidently uses the
    -- launch name as the @randomizationSalt@.
    CreateLaunch -> 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.
    CreateLaunch -> Maybe ScheduledSplitsLaunchConfig
scheduledSplitsConfig :: Prelude.Maybe ScheduledSplitsLaunchConfig,
    -- | Assigns one or more tags (key-value pairs) to the launch.
    --
    -- Tags can help you organize and categorize your resources. You can also
    -- use them to scope user permissions by granting a user permission to
    -- access or change only resources with certain tag values.
    --
    -- Tags don\'t have any semantic meaning to Amazon Web Services and are
    -- interpreted strictly as strings of characters.
    --
    -- >  <p>You can associate as many as 50 tags with a launch.</p> <p>For more information, see <a href="https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html">Tagging Amazon Web Services resources</a>.</p>
    CreateLaunch -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | An array of structures that contains the feature and variations that are
    -- to be used for the launch.
    CreateLaunch -> NonEmpty LaunchGroupConfig
groups :: Prelude.NonEmpty LaunchGroupConfig,
    -- | The name for the new launch.
    CreateLaunch -> Text
name :: Prelude.Text,
    -- | The name or ARN of the project that you want to create the launch in.
    CreateLaunch -> Text
project :: Prelude.Text
  }
  deriving (CreateLaunch -> CreateLaunch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLaunch -> CreateLaunch -> Bool
$c/= :: CreateLaunch -> CreateLaunch -> Bool
== :: CreateLaunch -> CreateLaunch -> Bool
$c== :: CreateLaunch -> CreateLaunch -> Bool
Prelude.Eq, ReadPrec [CreateLaunch]
ReadPrec CreateLaunch
Int -> ReadS CreateLaunch
ReadS [CreateLaunch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLaunch]
$creadListPrec :: ReadPrec [CreateLaunch]
readPrec :: ReadPrec CreateLaunch
$creadPrec :: ReadPrec CreateLaunch
readList :: ReadS [CreateLaunch]
$creadList :: ReadS [CreateLaunch]
readsPrec :: Int -> ReadS CreateLaunch
$creadsPrec :: Int -> ReadS CreateLaunch
Prelude.Read, Int -> CreateLaunch -> ShowS
[CreateLaunch] -> ShowS
CreateLaunch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLaunch] -> ShowS
$cshowList :: [CreateLaunch] -> ShowS
show :: CreateLaunch -> String
$cshow :: CreateLaunch -> String
showsPrec :: Int -> CreateLaunch -> ShowS
$cshowsPrec :: Int -> CreateLaunch -> ShowS
Prelude.Show, forall x. Rep CreateLaunch x -> CreateLaunch
forall x. CreateLaunch -> Rep CreateLaunch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLaunch x -> CreateLaunch
$cfrom :: forall x. CreateLaunch -> Rep CreateLaunch x
Prelude.Generic)

-- |
-- Create a value of 'CreateLaunch' 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', 'createLaunch_description' - An optional description for the launch.
--
-- 'metricMonitors', 'createLaunch_metricMonitors' - An array of structures that define the metrics that will be used to
-- monitor the launch performance.
--
-- 'randomizationSalt', 'createLaunch_randomizationSalt' - When Evidently assigns a particular user session to a launch, it must
-- use a randomization ID to determine which variation the user session is
-- served. This randomization ID is a combination of the entity ID and
-- @randomizationSalt@. If you omit @randomizationSalt@, Evidently uses the
-- launch name as the @randomizationSalt@.
--
-- 'scheduledSplitsConfig', 'createLaunch_scheduledSplitsConfig' - An array of structures that define the traffic allocation percentages
-- among the feature variations during each step of the launch.
--
-- 'tags', 'createLaunch_tags' - Assigns one or more tags (key-value pairs) to the launch.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- Tags don\'t have any semantic meaning to Amazon Web Services and are
-- interpreted strictly as strings of characters.
--
-- >  <p>You can associate as many as 50 tags with a launch.</p> <p>For more information, see <a href="https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html">Tagging Amazon Web Services resources</a>.</p>
--
-- 'groups', 'createLaunch_groups' - An array of structures that contains the feature and variations that are
-- to be used for the launch.
--
-- 'name', 'createLaunch_name' - The name for the new launch.
--
-- 'project', 'createLaunch_project' - The name or ARN of the project that you want to create the launch in.
newCreateLaunch ::
  -- | 'groups'
  Prelude.NonEmpty LaunchGroupConfig ->
  -- | 'name'
  Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  CreateLaunch
newCreateLaunch :: NonEmpty LaunchGroupConfig -> Text -> Text -> CreateLaunch
newCreateLaunch NonEmpty LaunchGroupConfig
pGroups_ Text
pName_ Text
pProject_ =
  CreateLaunch'
    { $sel:description:CreateLaunch' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:metricMonitors:CreateLaunch' :: Maybe [MetricMonitorConfig]
metricMonitors = forall a. Maybe a
Prelude.Nothing,
      $sel:randomizationSalt:CreateLaunch' :: Maybe Text
randomizationSalt = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduledSplitsConfig:CreateLaunch' :: Maybe ScheduledSplitsLaunchConfig
scheduledSplitsConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateLaunch' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:groups:CreateLaunch' :: NonEmpty LaunchGroupConfig
groups = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty LaunchGroupConfig
pGroups_,
      $sel:name:CreateLaunch' :: Text
name = Text
pName_,
      $sel:project:CreateLaunch' :: Text
project = Text
pProject_
    }

-- | An optional description for the launch.
createLaunch_description :: Lens.Lens' CreateLaunch (Prelude.Maybe Prelude.Text)
createLaunch_description :: Lens' CreateLaunch (Maybe Text)
createLaunch_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunch' {Maybe Text
description :: Maybe Text
$sel:description:CreateLaunch' :: CreateLaunch -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateLaunch
s@CreateLaunch' {} Maybe Text
a -> CreateLaunch
s {$sel:description:CreateLaunch' :: Maybe Text
description = Maybe Text
a} :: CreateLaunch)

-- | An array of structures that define the metrics that will be used to
-- monitor the launch performance.
createLaunch_metricMonitors :: Lens.Lens' CreateLaunch (Prelude.Maybe [MetricMonitorConfig])
createLaunch_metricMonitors :: Lens' CreateLaunch (Maybe [MetricMonitorConfig])
createLaunch_metricMonitors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunch' {Maybe [MetricMonitorConfig]
metricMonitors :: Maybe [MetricMonitorConfig]
$sel:metricMonitors:CreateLaunch' :: CreateLaunch -> Maybe [MetricMonitorConfig]
metricMonitors} -> Maybe [MetricMonitorConfig]
metricMonitors) (\s :: CreateLaunch
s@CreateLaunch' {} Maybe [MetricMonitorConfig]
a -> CreateLaunch
s {$sel:metricMonitors:CreateLaunch' :: Maybe [MetricMonitorConfig]
metricMonitors = Maybe [MetricMonitorConfig]
a} :: CreateLaunch) 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

-- | When Evidently assigns a particular user session to a launch, it must
-- use a randomization ID to determine which variation the user session is
-- served. This randomization ID is a combination of the entity ID and
-- @randomizationSalt@. If you omit @randomizationSalt@, Evidently uses the
-- launch name as the @randomizationSalt@.
createLaunch_randomizationSalt :: Lens.Lens' CreateLaunch (Prelude.Maybe Prelude.Text)
createLaunch_randomizationSalt :: Lens' CreateLaunch (Maybe Text)
createLaunch_randomizationSalt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunch' {Maybe Text
randomizationSalt :: Maybe Text
$sel:randomizationSalt:CreateLaunch' :: CreateLaunch -> Maybe Text
randomizationSalt} -> Maybe Text
randomizationSalt) (\s :: CreateLaunch
s@CreateLaunch' {} Maybe Text
a -> CreateLaunch
s {$sel:randomizationSalt:CreateLaunch' :: Maybe Text
randomizationSalt = Maybe Text
a} :: CreateLaunch)

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

-- | Assigns one or more tags (key-value pairs) to the launch.
--
-- Tags can help you organize and categorize your resources. You can also
-- use them to scope user permissions by granting a user permission to
-- access or change only resources with certain tag values.
--
-- Tags don\'t have any semantic meaning to Amazon Web Services and are
-- interpreted strictly as strings of characters.
--
-- >  <p>You can associate as many as 50 tags with a launch.</p> <p>For more information, see <a href="https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html">Tagging Amazon Web Services resources</a>.</p>
createLaunch_tags :: Lens.Lens' CreateLaunch (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createLaunch_tags :: Lens' CreateLaunch (Maybe (HashMap Text Text))
createLaunch_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunch' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateLaunch' :: CreateLaunch -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateLaunch
s@CreateLaunch' {} Maybe (HashMap Text Text)
a -> CreateLaunch
s {$sel:tags:CreateLaunch' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateLaunch) 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 contains the feature and variations that are
-- to be used for the launch.
createLaunch_groups :: Lens.Lens' CreateLaunch (Prelude.NonEmpty LaunchGroupConfig)
createLaunch_groups :: Lens' CreateLaunch (NonEmpty LaunchGroupConfig)
createLaunch_groups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunch' {NonEmpty LaunchGroupConfig
groups :: NonEmpty LaunchGroupConfig
$sel:groups:CreateLaunch' :: CreateLaunch -> NonEmpty LaunchGroupConfig
groups} -> NonEmpty LaunchGroupConfig
groups) (\s :: CreateLaunch
s@CreateLaunch' {} NonEmpty LaunchGroupConfig
a -> CreateLaunch
s {$sel:groups:CreateLaunch' :: NonEmpty LaunchGroupConfig
groups = NonEmpty LaunchGroupConfig
a} :: CreateLaunch) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

-- | The name or ARN of the project that you want to create the launch in.
createLaunch_project :: Lens.Lens' CreateLaunch Prelude.Text
createLaunch_project :: Lens' CreateLaunch Text
createLaunch_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunch' {Text
project :: Text
$sel:project:CreateLaunch' :: CreateLaunch -> Text
project} -> Text
project) (\s :: CreateLaunch
s@CreateLaunch' {} Text
a -> CreateLaunch
s {$sel:project:CreateLaunch' :: Text
project = Text
a} :: CreateLaunch)

instance Core.AWSRequest CreateLaunch where
  type AWSResponse CreateLaunch = CreateLaunchResponse
  request :: (Service -> Service) -> CreateLaunch -> Request CreateLaunch
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateLaunch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateLaunch)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Launch -> CreateLaunchResponse
CreateLaunchResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"launch")
      )

instance Prelude.Hashable CreateLaunch where
  hashWithSalt :: Int -> CreateLaunch -> Int
hashWithSalt Int
_salt CreateLaunch' {Maybe [MetricMonitorConfig]
Maybe Text
Maybe (HashMap Text Text)
Maybe ScheduledSplitsLaunchConfig
NonEmpty LaunchGroupConfig
Text
project :: Text
name :: Text
groups :: NonEmpty LaunchGroupConfig
tags :: Maybe (HashMap Text Text)
scheduledSplitsConfig :: Maybe ScheduledSplitsLaunchConfig
randomizationSalt :: Maybe Text
metricMonitors :: Maybe [MetricMonitorConfig]
description :: Maybe Text
$sel:project:CreateLaunch' :: CreateLaunch -> Text
$sel:name:CreateLaunch' :: CreateLaunch -> Text
$sel:groups:CreateLaunch' :: CreateLaunch -> NonEmpty LaunchGroupConfig
$sel:tags:CreateLaunch' :: CreateLaunch -> Maybe (HashMap Text Text)
$sel:scheduledSplitsConfig:CreateLaunch' :: CreateLaunch -> Maybe ScheduledSplitsLaunchConfig
$sel:randomizationSalt:CreateLaunch' :: CreateLaunch -> Maybe Text
$sel:metricMonitors:CreateLaunch' :: CreateLaunch -> Maybe [MetricMonitorConfig]
$sel:description:CreateLaunch' :: CreateLaunch -> 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 [MetricMonitorConfig]
metricMonitors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
randomizationSalt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ScheduledSplitsLaunchConfig
scheduledSplitsConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty LaunchGroupConfig
groups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project

instance Prelude.NFData CreateLaunch where
  rnf :: CreateLaunch -> ()
rnf CreateLaunch' {Maybe [MetricMonitorConfig]
Maybe Text
Maybe (HashMap Text Text)
Maybe ScheduledSplitsLaunchConfig
NonEmpty LaunchGroupConfig
Text
project :: Text
name :: Text
groups :: NonEmpty LaunchGroupConfig
tags :: Maybe (HashMap Text Text)
scheduledSplitsConfig :: Maybe ScheduledSplitsLaunchConfig
randomizationSalt :: Maybe Text
metricMonitors :: Maybe [MetricMonitorConfig]
description :: Maybe Text
$sel:project:CreateLaunch' :: CreateLaunch -> Text
$sel:name:CreateLaunch' :: CreateLaunch -> Text
$sel:groups:CreateLaunch' :: CreateLaunch -> NonEmpty LaunchGroupConfig
$sel:tags:CreateLaunch' :: CreateLaunch -> Maybe (HashMap Text Text)
$sel:scheduledSplitsConfig:CreateLaunch' :: CreateLaunch -> Maybe ScheduledSplitsLaunchConfig
$sel:randomizationSalt:CreateLaunch' :: CreateLaunch -> Maybe Text
$sel:metricMonitors:CreateLaunch' :: CreateLaunch -> Maybe [MetricMonitorConfig]
$sel:description:CreateLaunch' :: CreateLaunch -> 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 [MetricMonitorConfig]
metricMonitors
      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 ScheduledSplitsLaunchConfig
scheduledSplitsConfig
      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 NonEmpty LaunchGroupConfig
groups
      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 Text
project

instance Data.ToHeaders CreateLaunch where
  toHeaders :: CreateLaunch -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateLaunch where
  toJSON :: CreateLaunch -> Value
toJSON CreateLaunch' {Maybe [MetricMonitorConfig]
Maybe Text
Maybe (HashMap Text Text)
Maybe ScheduledSplitsLaunchConfig
NonEmpty LaunchGroupConfig
Text
project :: Text
name :: Text
groups :: NonEmpty LaunchGroupConfig
tags :: Maybe (HashMap Text Text)
scheduledSplitsConfig :: Maybe ScheduledSplitsLaunchConfig
randomizationSalt :: Maybe Text
metricMonitors :: Maybe [MetricMonitorConfig]
description :: Maybe Text
$sel:project:CreateLaunch' :: CreateLaunch -> Text
$sel:name:CreateLaunch' :: CreateLaunch -> Text
$sel:groups:CreateLaunch' :: CreateLaunch -> NonEmpty LaunchGroupConfig
$sel:tags:CreateLaunch' :: CreateLaunch -> Maybe (HashMap Text Text)
$sel:scheduledSplitsConfig:CreateLaunch' :: CreateLaunch -> Maybe ScheduledSplitsLaunchConfig
$sel:randomizationSalt:CreateLaunch' :: CreateLaunch -> Maybe Text
$sel:metricMonitors:CreateLaunch' :: CreateLaunch -> Maybe [MetricMonitorConfig]
$sel:description:CreateLaunch' :: CreateLaunch -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"metricMonitors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [MetricMonitorConfig]
metricMonitors,
            (Key
"randomizationSalt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
randomizationSalt,
            (Key
"scheduledSplitsConfig" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ScheduledSplitsLaunchConfig
scheduledSplitsConfig,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"groups" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty LaunchGroupConfig
groups),
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name)
          ]
      )

instance Data.ToPath CreateLaunch where
  toPath :: CreateLaunch -> ByteString
toPath CreateLaunch' {Maybe [MetricMonitorConfig]
Maybe Text
Maybe (HashMap Text Text)
Maybe ScheduledSplitsLaunchConfig
NonEmpty LaunchGroupConfig
Text
project :: Text
name :: Text
groups :: NonEmpty LaunchGroupConfig
tags :: Maybe (HashMap Text Text)
scheduledSplitsConfig :: Maybe ScheduledSplitsLaunchConfig
randomizationSalt :: Maybe Text
metricMonitors :: Maybe [MetricMonitorConfig]
description :: Maybe Text
$sel:project:CreateLaunch' :: CreateLaunch -> Text
$sel:name:CreateLaunch' :: CreateLaunch -> Text
$sel:groups:CreateLaunch' :: CreateLaunch -> NonEmpty LaunchGroupConfig
$sel:tags:CreateLaunch' :: CreateLaunch -> Maybe (HashMap Text Text)
$sel:scheduledSplitsConfig:CreateLaunch' :: CreateLaunch -> Maybe ScheduledSplitsLaunchConfig
$sel:randomizationSalt:CreateLaunch' :: CreateLaunch -> Maybe Text
$sel:metricMonitors:CreateLaunch' :: CreateLaunch -> Maybe [MetricMonitorConfig]
$sel:description:CreateLaunch' :: CreateLaunch -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/projects/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
project, ByteString
"/launches"]

instance Data.ToQuery CreateLaunch where
  toQuery :: CreateLaunch -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateLaunchResponse' smart constructor.
data CreateLaunchResponse = CreateLaunchResponse'
  { -- | The response's http status code.
    CreateLaunchResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure that contains the configuration of the launch that was
    -- created.
    CreateLaunchResponse -> Launch
launch :: Launch
  }
  deriving (CreateLaunchResponse -> CreateLaunchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateLaunchResponse -> CreateLaunchResponse -> Bool
$c/= :: CreateLaunchResponse -> CreateLaunchResponse -> Bool
== :: CreateLaunchResponse -> CreateLaunchResponse -> Bool
$c== :: CreateLaunchResponse -> CreateLaunchResponse -> Bool
Prelude.Eq, ReadPrec [CreateLaunchResponse]
ReadPrec CreateLaunchResponse
Int -> ReadS CreateLaunchResponse
ReadS [CreateLaunchResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateLaunchResponse]
$creadListPrec :: ReadPrec [CreateLaunchResponse]
readPrec :: ReadPrec CreateLaunchResponse
$creadPrec :: ReadPrec CreateLaunchResponse
readList :: ReadS [CreateLaunchResponse]
$creadList :: ReadS [CreateLaunchResponse]
readsPrec :: Int -> ReadS CreateLaunchResponse
$creadsPrec :: Int -> ReadS CreateLaunchResponse
Prelude.Read, Int -> CreateLaunchResponse -> ShowS
[CreateLaunchResponse] -> ShowS
CreateLaunchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateLaunchResponse] -> ShowS
$cshowList :: [CreateLaunchResponse] -> ShowS
show :: CreateLaunchResponse -> String
$cshow :: CreateLaunchResponse -> String
showsPrec :: Int -> CreateLaunchResponse -> ShowS
$cshowsPrec :: Int -> CreateLaunchResponse -> ShowS
Prelude.Show, forall x. Rep CreateLaunchResponse x -> CreateLaunchResponse
forall x. CreateLaunchResponse -> Rep CreateLaunchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateLaunchResponse x -> CreateLaunchResponse
$cfrom :: forall x. CreateLaunchResponse -> Rep CreateLaunchResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateLaunchResponse' 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:
--
-- 'httpStatus', 'createLaunchResponse_httpStatus' - The response's http status code.
--
-- 'launch', 'createLaunchResponse_launch' - A structure that contains the configuration of the launch that was
-- created.
newCreateLaunchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'launch'
  Launch ->
  CreateLaunchResponse
newCreateLaunchResponse :: Int -> Launch -> CreateLaunchResponse
newCreateLaunchResponse Int
pHttpStatus_ Launch
pLaunch_ =
  CreateLaunchResponse'
    { $sel:httpStatus:CreateLaunchResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:launch:CreateLaunchResponse' :: Launch
launch = Launch
pLaunch_
    }

-- | The response's http status code.
createLaunchResponse_httpStatus :: Lens.Lens' CreateLaunchResponse Prelude.Int
createLaunchResponse_httpStatus :: Lens' CreateLaunchResponse Int
createLaunchResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateLaunchResponse' :: CreateLaunchResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateLaunchResponse
s@CreateLaunchResponse' {} Int
a -> CreateLaunchResponse
s {$sel:httpStatus:CreateLaunchResponse' :: Int
httpStatus = Int
a} :: CreateLaunchResponse)

-- | A structure that contains the configuration of the launch that was
-- created.
createLaunchResponse_launch :: Lens.Lens' CreateLaunchResponse Launch
createLaunchResponse_launch :: Lens' CreateLaunchResponse Launch
createLaunchResponse_launch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateLaunchResponse' {Launch
launch :: Launch
$sel:launch:CreateLaunchResponse' :: CreateLaunchResponse -> Launch
launch} -> Launch
launch) (\s :: CreateLaunchResponse
s@CreateLaunchResponse' {} Launch
a -> CreateLaunchResponse
s {$sel:launch:CreateLaunchResponse' :: Launch
launch = Launch
a} :: CreateLaunchResponse)

instance Prelude.NFData CreateLaunchResponse where
  rnf :: CreateLaunchResponse -> ()
rnf CreateLaunchResponse' {Int
Launch
launch :: Launch
httpStatus :: Int
$sel:launch:CreateLaunchResponse' :: CreateLaunchResponse -> Launch
$sel:httpStatus:CreateLaunchResponse' :: CreateLaunchResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Launch
launch