{-# 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.UpdateLaunch
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a launch of a given feature.
--
-- Don\'t use this operation to update the tags of an existing launch.
-- Instead, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_TagResource.html TagResource>.
module Amazonka.Evidently.UpdateLaunch
  ( -- * Creating a Request
    UpdateLaunch (..),
    newUpdateLaunch,

    -- * Request Lenses
    updateLaunch_description,
    updateLaunch_groups,
    updateLaunch_metricMonitors,
    updateLaunch_randomizationSalt,
    updateLaunch_scheduledSplitsConfig,
    updateLaunch_launch,
    updateLaunch_project,

    -- * Destructuring the Response
    UpdateLaunchResponse (..),
    newUpdateLaunchResponse,

    -- * Response Lenses
    updateLaunchResponse_httpStatus,
    updateLaunchResponse_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:/ 'newUpdateLaunch' smart constructor.
data UpdateLaunch = UpdateLaunch'
  { -- | An optional description for the launch.
    UpdateLaunch -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | An array of structures that contains the feature and variations that are
    -- to be used for the launch.
    UpdateLaunch -> Maybe (NonEmpty LaunchGroupConfig)
groups :: Prelude.Maybe (Prelude.NonEmpty LaunchGroupConfig),
    -- | An array of structures that define the metrics that will be used to
    -- monitor the launch performance.
    UpdateLaunch -> 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@.
    UpdateLaunch -> 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.
    UpdateLaunch -> Maybe ScheduledSplitsLaunchConfig
scheduledSplitsConfig :: Prelude.Maybe ScheduledSplitsLaunchConfig,
    -- | The name of the launch that is to be updated.
    UpdateLaunch -> Text
launch :: Prelude.Text,
    -- | The name or ARN of the project that contains the launch that you want to
    -- update.
    UpdateLaunch -> Text
project :: Prelude.Text
  }
  deriving (UpdateLaunch -> UpdateLaunch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateLaunch -> UpdateLaunch -> Bool
$c/= :: UpdateLaunch -> UpdateLaunch -> Bool
== :: UpdateLaunch -> UpdateLaunch -> Bool
$c== :: UpdateLaunch -> UpdateLaunch -> Bool
Prelude.Eq, ReadPrec [UpdateLaunch]
ReadPrec UpdateLaunch
Int -> ReadS UpdateLaunch
ReadS [UpdateLaunch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateLaunch]
$creadListPrec :: ReadPrec [UpdateLaunch]
readPrec :: ReadPrec UpdateLaunch
$creadPrec :: ReadPrec UpdateLaunch
readList :: ReadS [UpdateLaunch]
$creadList :: ReadS [UpdateLaunch]
readsPrec :: Int -> ReadS UpdateLaunch
$creadsPrec :: Int -> ReadS UpdateLaunch
Prelude.Read, Int -> UpdateLaunch -> ShowS
[UpdateLaunch] -> ShowS
UpdateLaunch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateLaunch] -> ShowS
$cshowList :: [UpdateLaunch] -> ShowS
show :: UpdateLaunch -> String
$cshow :: UpdateLaunch -> String
showsPrec :: Int -> UpdateLaunch -> ShowS
$cshowsPrec :: Int -> UpdateLaunch -> ShowS
Prelude.Show, forall x. Rep UpdateLaunch x -> UpdateLaunch
forall x. UpdateLaunch -> Rep UpdateLaunch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateLaunch x -> UpdateLaunch
$cfrom :: forall x. UpdateLaunch -> Rep UpdateLaunch x
Prelude.Generic)

-- |
-- Create a value of 'UpdateLaunch' 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', 'updateLaunch_description' - An optional description for the launch.
--
-- 'groups', 'updateLaunch_groups' - An array of structures that contains the feature and variations that are
-- to be used for the launch.
--
-- 'metricMonitors', 'updateLaunch_metricMonitors' - An array of structures that define the metrics that will be used to
-- monitor the launch performance.
--
-- 'randomizationSalt', 'updateLaunch_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', 'updateLaunch_scheduledSplitsConfig' - An array of structures that define the traffic allocation percentages
-- among the feature variations during each step of the launch.
--
-- 'launch', 'updateLaunch_launch' - The name of the launch that is to be updated.
--
-- 'project', 'updateLaunch_project' - The name or ARN of the project that contains the launch that you want to
-- update.
newUpdateLaunch ::
  -- | 'launch'
  Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  UpdateLaunch
newUpdateLaunch :: Text -> Text -> UpdateLaunch
newUpdateLaunch Text
pLaunch_ Text
pProject_ =
  UpdateLaunch'
    { $sel:description:UpdateLaunch' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:groups:UpdateLaunch' :: Maybe (NonEmpty LaunchGroupConfig)
groups = forall a. Maybe a
Prelude.Nothing,
      $sel:metricMonitors:UpdateLaunch' :: Maybe [MetricMonitorConfig]
metricMonitors = forall a. Maybe a
Prelude.Nothing,
      $sel:randomizationSalt:UpdateLaunch' :: Maybe Text
randomizationSalt = forall a. Maybe a
Prelude.Nothing,
      $sel:scheduledSplitsConfig:UpdateLaunch' :: Maybe ScheduledSplitsLaunchConfig
scheduledSplitsConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:launch:UpdateLaunch' :: Text
launch = Text
pLaunch_,
      $sel:project:UpdateLaunch' :: Text
project = Text
pProject_
    }

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

-- | An array of structures that contains the feature and variations that are
-- to be used for the launch.
updateLaunch_groups :: Lens.Lens' UpdateLaunch (Prelude.Maybe (Prelude.NonEmpty LaunchGroupConfig))
updateLaunch_groups :: Lens' UpdateLaunch (Maybe (NonEmpty LaunchGroupConfig))
updateLaunch_groups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunch' {Maybe (NonEmpty LaunchGroupConfig)
groups :: Maybe (NonEmpty LaunchGroupConfig)
$sel:groups:UpdateLaunch' :: UpdateLaunch -> Maybe (NonEmpty LaunchGroupConfig)
groups} -> Maybe (NonEmpty LaunchGroupConfig)
groups) (\s :: UpdateLaunch
s@UpdateLaunch' {} Maybe (NonEmpty LaunchGroupConfig)
a -> UpdateLaunch
s {$sel:groups:UpdateLaunch' :: Maybe (NonEmpty LaunchGroupConfig)
groups = Maybe (NonEmpty LaunchGroupConfig)
a} :: UpdateLaunch) 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 will be used to
-- monitor the launch performance.
updateLaunch_metricMonitors :: Lens.Lens' UpdateLaunch (Prelude.Maybe [MetricMonitorConfig])
updateLaunch_metricMonitors :: Lens' UpdateLaunch (Maybe [MetricMonitorConfig])
updateLaunch_metricMonitors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunch' {Maybe [MetricMonitorConfig]
metricMonitors :: Maybe [MetricMonitorConfig]
$sel:metricMonitors:UpdateLaunch' :: UpdateLaunch -> Maybe [MetricMonitorConfig]
metricMonitors} -> Maybe [MetricMonitorConfig]
metricMonitors) (\s :: UpdateLaunch
s@UpdateLaunch' {} Maybe [MetricMonitorConfig]
a -> UpdateLaunch
s {$sel:metricMonitors:UpdateLaunch' :: Maybe [MetricMonitorConfig]
metricMonitors = Maybe [MetricMonitorConfig]
a} :: UpdateLaunch) 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@.
updateLaunch_randomizationSalt :: Lens.Lens' UpdateLaunch (Prelude.Maybe Prelude.Text)
updateLaunch_randomizationSalt :: Lens' UpdateLaunch (Maybe Text)
updateLaunch_randomizationSalt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunch' {Maybe Text
randomizationSalt :: Maybe Text
$sel:randomizationSalt:UpdateLaunch' :: UpdateLaunch -> Maybe Text
randomizationSalt} -> Maybe Text
randomizationSalt) (\s :: UpdateLaunch
s@UpdateLaunch' {} Maybe Text
a -> UpdateLaunch
s {$sel:randomizationSalt:UpdateLaunch' :: Maybe Text
randomizationSalt = Maybe Text
a} :: UpdateLaunch)

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

-- | The name of the launch that is to be updated.
updateLaunch_launch :: Lens.Lens' UpdateLaunch Prelude.Text
updateLaunch_launch :: Lens' UpdateLaunch Text
updateLaunch_launch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateLaunch' {Text
launch :: Text
$sel:launch:UpdateLaunch' :: UpdateLaunch -> Text
launch} -> Text
launch) (\s :: UpdateLaunch
s@UpdateLaunch' {} Text
a -> UpdateLaunch
s {$sel:launch:UpdateLaunch' :: Text
launch = Text
a} :: UpdateLaunch)

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

instance Core.AWSRequest UpdateLaunch where
  type AWSResponse UpdateLaunch = UpdateLaunchResponse
  request :: (Service -> Service) -> UpdateLaunch -> Request UpdateLaunch
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateLaunch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateLaunch)))
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 -> UpdateLaunchResponse
UpdateLaunchResponse'
            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 UpdateLaunch where
  hashWithSalt :: Int -> UpdateLaunch -> Int
hashWithSalt Int
_salt UpdateLaunch' {Maybe [MetricMonitorConfig]
Maybe (NonEmpty LaunchGroupConfig)
Maybe Text
Maybe ScheduledSplitsLaunchConfig
Text
project :: Text
launch :: Text
scheduledSplitsConfig :: Maybe ScheduledSplitsLaunchConfig
randomizationSalt :: Maybe Text
metricMonitors :: Maybe [MetricMonitorConfig]
groups :: Maybe (NonEmpty LaunchGroupConfig)
description :: Maybe Text
$sel:project:UpdateLaunch' :: UpdateLaunch -> Text
$sel:launch:UpdateLaunch' :: UpdateLaunch -> Text
$sel:scheduledSplitsConfig:UpdateLaunch' :: UpdateLaunch -> Maybe ScheduledSplitsLaunchConfig
$sel:randomizationSalt:UpdateLaunch' :: UpdateLaunch -> Maybe Text
$sel:metricMonitors:UpdateLaunch' :: UpdateLaunch -> Maybe [MetricMonitorConfig]
$sel:groups:UpdateLaunch' :: UpdateLaunch -> Maybe (NonEmpty LaunchGroupConfig)
$sel:description:UpdateLaunch' :: UpdateLaunch -> 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 (NonEmpty LaunchGroupConfig)
groups
      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` Text
launch
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
project

instance Prelude.NFData UpdateLaunch where
  rnf :: UpdateLaunch -> ()
rnf UpdateLaunch' {Maybe [MetricMonitorConfig]
Maybe (NonEmpty LaunchGroupConfig)
Maybe Text
Maybe ScheduledSplitsLaunchConfig
Text
project :: Text
launch :: Text
scheduledSplitsConfig :: Maybe ScheduledSplitsLaunchConfig
randomizationSalt :: Maybe Text
metricMonitors :: Maybe [MetricMonitorConfig]
groups :: Maybe (NonEmpty LaunchGroupConfig)
description :: Maybe Text
$sel:project:UpdateLaunch' :: UpdateLaunch -> Text
$sel:launch:UpdateLaunch' :: UpdateLaunch -> Text
$sel:scheduledSplitsConfig:UpdateLaunch' :: UpdateLaunch -> Maybe ScheduledSplitsLaunchConfig
$sel:randomizationSalt:UpdateLaunch' :: UpdateLaunch -> Maybe Text
$sel:metricMonitors:UpdateLaunch' :: UpdateLaunch -> Maybe [MetricMonitorConfig]
$sel:groups:UpdateLaunch' :: UpdateLaunch -> Maybe (NonEmpty LaunchGroupConfig)
$sel:description:UpdateLaunch' :: UpdateLaunch -> 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 (NonEmpty LaunchGroupConfig)
groups
      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 Text
launch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project

instance Data.ToHeaders UpdateLaunch where
  toHeaders :: UpdateLaunch -> 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 UpdateLaunch where
  toJSON :: UpdateLaunch -> Value
toJSON UpdateLaunch' {Maybe [MetricMonitorConfig]
Maybe (NonEmpty LaunchGroupConfig)
Maybe Text
Maybe ScheduledSplitsLaunchConfig
Text
project :: Text
launch :: Text
scheduledSplitsConfig :: Maybe ScheduledSplitsLaunchConfig
randomizationSalt :: Maybe Text
metricMonitors :: Maybe [MetricMonitorConfig]
groups :: Maybe (NonEmpty LaunchGroupConfig)
description :: Maybe Text
$sel:project:UpdateLaunch' :: UpdateLaunch -> Text
$sel:launch:UpdateLaunch' :: UpdateLaunch -> Text
$sel:scheduledSplitsConfig:UpdateLaunch' :: UpdateLaunch -> Maybe ScheduledSplitsLaunchConfig
$sel:randomizationSalt:UpdateLaunch' :: UpdateLaunch -> Maybe Text
$sel:metricMonitors:UpdateLaunch' :: UpdateLaunch -> Maybe [MetricMonitorConfig]
$sel:groups:UpdateLaunch' :: UpdateLaunch -> Maybe (NonEmpty LaunchGroupConfig)
$sel:description:UpdateLaunch' :: UpdateLaunch -> 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
"groups" 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 (NonEmpty LaunchGroupConfig)
groups,
            (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
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateLaunchResponse' 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', 'updateLaunchResponse_httpStatus' - The response's http status code.
--
-- 'launch', 'updateLaunchResponse_launch' - A structure that contains the new configuration of the launch that was
-- updated.
newUpdateLaunchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'launch'
  Launch ->
  UpdateLaunchResponse
newUpdateLaunchResponse :: Int -> Launch -> UpdateLaunchResponse
newUpdateLaunchResponse Int
pHttpStatus_ Launch
pLaunch_ =
  UpdateLaunchResponse'
    { $sel:httpStatus:UpdateLaunchResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:launch:UpdateLaunchResponse' :: Launch
launch = Launch
pLaunch_
    }

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

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

instance Prelude.NFData UpdateLaunchResponse where
  rnf :: UpdateLaunchResponse -> ()
rnf UpdateLaunchResponse' {Int
Launch
launch :: Launch
httpStatus :: Int
$sel:launch:UpdateLaunchResponse' :: UpdateLaunchResponse -> Launch
$sel:httpStatus:UpdateLaunchResponse' :: UpdateLaunchResponse -> 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